packages feed

streamly 0.10.1 → 0.11.0

raw patch · 218 files changed

+22037/−14325 lines, 218 filesdep +fusion-plugin-typesdep ~Win32dep ~atomic-primopsdep ~basebinary-added

Dependencies added: fusion-plugin-types

Dependency ranges changed: Win32, atomic-primops, base, containers, inspection-testing, primitive, streamly-core, template-haskell, unicode-data

Files

CHANGELOG.md view
@@ -2,6 +2,33 @@  <!-- See rendered changelog at https://streamly.composewell.com --> +## 0.11.0++See+[0.10.1-0.11.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.11.0/docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt)+for detailed API changes in this release.++### Breaking Changes++* Concurrent streams and folds now use separate concurrency config types. If you+  were importing `Config` from the wrong module, you will need to update it.++### Enhancements++* Support for prompt cleanup of concurrent threads, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Introduced `Streamly.Data.Scanl.Prelude` for using concurrent+  operations with the new `Scanl` type. Scans can split a stream into+  multiple streams, process them concurrently, and merge the results.+* Added new concurrent fold combinators in `Streamly.Data.Fold.Prelude`.+* Fixed rate control for ordered streams.++### Internal++* Internal `FileSystem.Event.*` modules are deprecated; use the+  [streamly-fsevents](https://github.com/composewell/streamly-fsevents) package.+  instead.+ ## 0.10.1 (Jan 2024)  * Fix TH macros in `Streamly.Data.Stream.MkType` for GHC 9.6 and above.@@ -82,7 +109,7 @@ `StreamK` types can be easily interconverted.  The old code can be adapted to use the new modules with some changes.-See the +See the [streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md) for more details on how to adapt your existing code to the new release. @@ -137,7 +164,7 @@  ## 0.8.1 (Nov 2021) -See ApiChangelogs/0.8.3.txt for new APIs introduced.+See ApiChangelogs/0.8.0-0.8.1.txt for new APIs introduced.  ### Bug Fixes @@ -165,7 +192,7 @@  ## 0.8.0 (Jun 2021) -See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of signature+See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of signature changes and new APIs introduced.  ### Breaking changes@@ -204,7 +231,7 @@  ### Enhancements -* See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of new+* See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of new   modules and APIs introduced. * The Fold type is now more powerful, the new termination behavior allows   to express basic parsing of streams using folds.
README.md view
@@ -1,6 +1,7 @@ # [Streamly][]: Idiomatic Haskell with C-Like Performance  [![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)+[![Hackage](https://img.shields.io/hackage/v/streamly-core.svg?style=flat)](https://hackage.haskell.org/package/streamly-core) [![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)  ## Upgrading to 0.9.0+@@ -23,11 +24,9 @@ * Fearless, declarative concurrency for seamless parallel execution. * A collection of ecosystem libraries for fast and efficient development. -Check out the [Streamly Getting Started-Guide](/docs/User/Tutorials/getting-started.md) and [Quick-Overview](/docs/User/Tutorials/quick-overview.md) for an introduction-to the library. For more detailed documentation, visit the [Haskell-Streamly website][Streamly].+Check out the [Learn By Examples](/docs/User/Tutorials/learn-by-examples.md)+page for an introduction to the library. For more detailed documentation, visit+the [Haskell Streamly website][Streamly].  ## Blazing Fast @@ -94,7 +93,7 @@   * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))   * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient)) -Please see the [`credits`](/docs/User/ProjectRelated/Credits.md) directory for a full+Please see the [`credits`](/docs/User/Project/Credits.md) directory for a full list of contributors, credits and licenses.  ## Licensing
+ bench-test-lib/bench-test-lib.cabal view
@@ -0,0 +1,67 @@+cabal-version:      3.0+name:               bench-test-lib+version:            0.1.0.0+build-type:         Simple++common compile-options+    default-language: Haskell2010+    ghc-options:    -Weverything+                    -Wno-implicit-prelude+                    -Wno-missing-deriving-strategies+                    -Wno-missing-exported-signatures+                    -Wno-missing-import-lists+                    -Wno-missing-local-signatures+                    -Wno-missing-safe-haskell-mode+                    -Wno-missed-specialisations+                    -Wno-all-missed-specialisations+                    -Wno-monomorphism-restriction+                    -Wno-prepositive-qualified-module+                    -Wno-unsafe+                    -Rghc-timing++    if impl(ghc >= 9.2)+      ghc-options:+        -Wno-missing-kind-signatures+        -Wno-redundant-bang-patterns+        -Wno-operator-whitespace++    if impl(ghc >= 9.8)+      ghc-options:+        -Wno-missing-role-annotations++common default-extensions+    default-extensions:+        BangPatterns+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        InstanceSigs+        KindSignatures+        MultiParamTypeClasses+        RankNTypes+        ScopedTypeVariables+        TupleSections+        TypeApplications+        TypeOperators++        -- Not GHC2021+        CApiFFI+        CPP+        LambdaCase+        MagicHash+        RecordWildCards++library+    import:           compile-options, default-extensions+    exposed-modules:  BenchTestLib.DirIO+    build-depends:    base+                    , streamly-core+                    , streamly+                    , directory+    hs-source-dirs:   src+    default-language: Haskell2010
+ bench-test-lib/src/BenchTestLib/DirIO.hs view
@@ -0,0 +1,300 @@+-- |+-- Module      : BenchTestLib.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE QuasiQuotes #-}++module BenchTestLib.DirIO+    ( createDirStucture+    , listDirUnfoldDfs+    , listDirUnfoldBfs+    , listDirUnfoldBfsRev+    , listDirConcatDfs+    , listDirConcatBfs+    , listDirConcatBfsRev+    , listDirAppend+    , listDirInterleave+    , listDirPar+    , listDirParInterleaved+    , listDirParOrdered+    , listDirChunkDfs+    , listDirChunkBfs+    , listDirChunkBfsRev+    , listDirChunkAppend+    , listDirChunkInterleave+    , listDirChunkPar+    , listDirChunkParInterleaved+    , listDirChunkParOrdered+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+    , listDirByteChunked+#endif+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.IORef (newIORef, modifyIORef', readIORef)+import Data.Maybe (fromJust)+import Data.Word (Word8)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Data.Array (Array)+#endif+import Streamly.Data.Stream (Stream)+import Streamly.Data.Unfold (Unfold)+import Streamly.FileSystem.Path (Path)+import Streamly.Unicode.String (str)+import System.Directory (createDirectoryIfMissing)+import Data.Foldable (for_)++import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Array as Array+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.FileSystem.DirIO as Dir+import qualified Streamly.FileSystem.Path as Path+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import qualified Streamly.Internal.FileSystem.Posix.ReadDir as Dir+#endif++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++concatIterateWith :: Monad m =>+                           (a -> Stream m a)+                           -> (StreamK.StreamK m a+                               -> StreamK.StreamK m a -> StreamK.StreamK m a)+                           -> Stream m a+                           -> Stream m a+concatIterateWith nxt f =+      StreamK.toStream+    . StreamK.concatIterateWith f (StreamK.fromStream . nxt)+    . StreamK.fromStream++mergeIterateWith :: Monad m =>+                          (a -> Stream m a)+                          -> (StreamK.StreamK m a+                              -> StreamK.StreamK m a -> StreamK.StreamK m a)+                          -> Stream m a+                          -> Stream m a+mergeIterateWith nxt f =+      StreamK.toStream+    . StreamK.mergeIterateWith f (StreamK.fromStream . nxt)+    . StreamK.fromStream++streamDir+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either Path b -> Stream IO (Either Path Path)+streamDir f = either (Dir.readEitherPaths f) (const Stream.nil)++unfoldDir+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Unfold IO (Either Path b) (Either Path Path)+unfoldDir f = Unfold.either (Dir.eitherReaderPaths f) Unfold.nil++streamDirMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either Path b -> Maybe (Stream IO (Either Path Path))+streamDirMaybe f = either (Just . Dir.readEitherPaths f) (const Nothing)++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+_streamDirByteChunked+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Stream IO (Either [Path] (Array Word8))+_streamDirByteChunked f = either (Dir.readEitherByteChunks f) (const Stream.nil)++streamDirByteChunkedMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Maybe (Stream IO (Either [Path] (Array Word8)))+streamDirByteChunkedMaybe f =+    either (Just . Dir.readEitherByteChunks f) (const Nothing)+#endif++streamDirChunkedMaybe+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Maybe (Stream IO (Either [Path] [Path]))+streamDirChunkedMaybe f = either (Just . Dir.readEitherChunks f) (const Nothing)++streamDirChunked+    :: (Dir.ReadOptions -> Dir.ReadOptions)+    -> Either [Path] b -> Stream IO (Either [Path] [Path])+streamDirChunked f = either (Dir.readEitherChunks f) (const Stream.nil)++--------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------++createDirStucture :: FilePath -> Int -> Int -> IO [FilePath]+createDirStucture root d w = do+    ref <- newIORef [root]+    createDirStucture_ ref root d w+    readIORef ref+    where+    createDirStucture_ _ _ depth _ | depth <= 0 = pure ()+    createDirStucture_ ref parentDir depth width = do+        for_ [1..width] $ \i -> do+            let iStr = show i+                subDir = [str|#{parentDir}/dir_#{iStr}|]+            createDirectoryIfMissing True subDir+            modifyIORef' ref (subDir:)+            createDirStucture_ ref subDir (depth - 1) width++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+-- Fastest implementation, only works for posix as of now.+{-# INLINE listDirByteChunked #-}+listDirByteChunked :: FilePath -> Stream IO (Array Word8)+listDirByteChunked inp = do+     Stream.catRights+        $ Stream.concatIterate (streamDirByteChunkedMaybe id)+        $ Stream.fromPure (Left [fromJust $ Path.fromString inp])+#endif++-- Faster than the listDir implementation below+{-# INLINE listDirChunkedWith #-}+listDirChunkedWith+    :: (Stream IO (Either [Path] b) -> Stream IO (Either [Path] [Path]))+    -> [Char] -> Stream IO Word8+listDirChunkedWith act inp = do+     Stream.unfoldEachEndBy 10 Array.reader+        $ fmap (Array.asBytes . Path.toArray)+        $ Stream.unfoldEach Unfold.fromList+        $ fmap (either id id)+        $ act+        $ Stream.fromPure (Left [fromJust $ Path.fromString inp])++{-# INLINE listDirWith #-}+listDirWith+    :: (Stream IO (Either Path Path) -> Stream IO (Either Path Path))+    -> [Char] -> Stream IO Word8+listDirWith act inp = do+     Stream.unfoldEachEndBy 10 Array.reader+        $ fmap (Array.asBytes . Path.toArray . either id id)+        $ act+        $ Stream.fromPure (Left (fromJust $ Path.fromString inp))++--------------------------------------------------------------------------------+-- Non chunked+--------------------------------------------------------------------------------++{-# INLINE listDirUnfoldDfs #-}+listDirUnfoldDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldDfs f = listDirWith (Stream.unfoldIterate (unfoldDir f))++{-# INLINE listDirUnfoldBfs #-}+listDirUnfoldBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldBfs f = listDirWith (Stream.bfsUnfoldIterate (unfoldDir f))++{-# INLINE listDirUnfoldBfsRev #-}+listDirUnfoldBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirUnfoldBfsRev f = listDirWith (Stream.altBfsUnfoldIterate (unfoldDir f))++{-# INLINE listDirConcatDfs #-}+listDirConcatDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatDfs f = listDirWith (Stream.concatIterate (streamDirMaybe f))++{-# INLINE listDirConcatBfs #-}+listDirConcatBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatBfs f = listDirWith (Stream.bfsConcatIterate (streamDirMaybe f))++{-# INLINE listDirConcatBfsRev #-}+listDirConcatBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirConcatBfsRev f =+    listDirWith (Stream.altBfsConcatIterate (streamDirMaybe f))++{-# INLINE listDirAppend #-}+listDirAppend+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirAppend f = listDirWith (concatIterateWith (streamDir f) StreamK.append)++{-# INLINE listDirInterleave #-}+listDirInterleave+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirInterleave f =+    listDirWith (mergeIterateWith (streamDir f) StreamK.interleave)++{-# INLINE listDirPar #-}+listDirPar+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirPar f = listDirWith (Stream.parConcatIterate id (streamDir f))++{-# INLINE listDirParInterleaved #-}+listDirParInterleaved+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirParInterleaved f =+    listDirWith+        (Stream.parConcatIterate (Stream.interleaved True) (streamDir f))++{-# INLINE listDirParOrdered #-}+listDirParOrdered+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirParOrdered f =+    listDirWith (Stream.parConcatIterate (Stream.ordered True) (streamDir f))++--------------------------------------------------------------------------------+-- Chunked+--------------------------------------------------------------------------------++{-# INLINE listDirChunkDfs #-}+listDirChunkDfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkDfs f =+    listDirChunkedWith (Stream.concatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkBfs #-}+listDirChunkBfs+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkBfs f =+    listDirChunkedWith (Stream.bfsConcatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkBfsRev #-}+listDirChunkBfsRev+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkBfsRev f =+    listDirChunkedWith (Stream.altBfsConcatIterate (streamDirChunkedMaybe f))++{-# INLINE listDirChunkAppend #-}+listDirChunkAppend+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkAppend f =+    listDirChunkedWith (concatIterateWith (streamDirChunked f) StreamK.append)++{-# INLINE listDirChunkInterleave #-}+listDirChunkInterleave+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkInterleave f =+    listDirChunkedWith+        (mergeIterateWith (streamDirChunked f) StreamK.interleave)++{-# INLINE listDirChunkPar #-}+listDirChunkPar+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkPar f =+    listDirChunkedWith (Stream.parConcatIterate id (streamDirChunked f))++{-# INLINE listDirChunkParInterleaved #-}+listDirChunkParInterleaved+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkParInterleaved f =+    listDirChunkedWith+        (Stream.parConcatIterate (Stream.interleaved True) (streamDirChunked f))++{-# INLINE listDirChunkParOrdered #-}+listDirChunkParOrdered+    :: (Dir.ReadOptions -> Dir.ReadOptions) -> [Char] -> Stream IO Word8+listDirChunkParOrdered f =+    listDirChunkedWith+        (Stream.parConcatIterate (Stream.ordered True) (streamDirChunked f))
benchmark/Streamly/Benchmark/Data/Array.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-}  {-# LANGUAGE CPP #-}@@ -6,6 +5,9 @@ #include "Streamly/Benchmark/Data/Array/CommonImports.hs"  import Control.DeepSeq (deepseq)+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif  import qualified Streamly.Internal.Data.Array as IA import qualified GHC.Exts as GHC@@ -13,6 +15,9 @@ -- import qualified Streamly.Data.Array as A import qualified Streamly.Internal.Data.Array as A +#if __GLASGOW_HASKELL__ >= 810+type Stream :: Type -> Type+#endif type Stream = A.Array  #include "Streamly/Benchmark/Data/Array/Common.hs"@@ -73,7 +78,7 @@  {-# INLINE sourceIntFromToFromStream #-} sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromToFromStream value n = S.fold A.write $ S.enumerateFromTo n (n + value)+sourceIntFromToFromStream value n = S.fold A.create $ S.enumerateFromTo n (n + value)  ------------------------------------------------------------------------------- -- Bench groups@@ -98,10 +103,10 @@ o_1_space_elimination value =     [ bgroup "elimination"         [ benchPureSink value "length . IsList.toList" (length . GHC.toList)-        , benchFold "writeLastN.1"-            (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)-        , benchFold "writeLastN.10"-            (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)+        , benchFold "createOfLast.1"+            (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value)+        , benchFold "createOfLast.10"+            (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value) #ifdef DEVBUILD {-           benchPureSink value "foldable/foldl'" foldableFoldl'@@ -116,7 +121,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))+            benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1)))                 (P.sourceUnfoldrM value)          ]     ]
benchmark/Streamly/Benchmark/Data/Array/Common.hs view
@@ -26,7 +26,7 @@  {-# INLINE sourceUnfoldr #-} sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int)-sourceUnfoldr value n = S.fold (A.writeN value) $ S.unfoldr step n+sourceUnfoldr value n = S.fold (A.createOf value) $ S.unfoldr step n     where     step cnt =         if cnt > n + value@@ -35,11 +35,11 @@  {-# INLINE sourceIntFromTo #-} sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int)-sourceIntFromTo value n = S.fold (A.writeN value) $ S.enumerateFromTo n (n + value)+sourceIntFromTo value n = S.fold (A.createOf value) $ S.enumerateFromTo n (n + value)  {-# INLINE sourceFromList #-} sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int)-sourceFromList value n = S.fold (A.writeN value) $ S.fromList [n..n+value]+sourceFromList value n = S.fold (A.createOf value) $ S.fromList [n..n+value]  ------------------------------------------------------------------------------- -- Transformation@@ -69,9 +69,9 @@     :: MonadIO m => Int -> (Stream.Stream m Int -> Stream.Stream m Int)     -> Stream Int     -> m (Stream Int)-onArray value f arr = S.fold (A.writeN value) $ f $ S.unfold A.reader arr+onArray value f arr = S.fold (A.createOf value) $ f $ S.unfold A.reader arr -scanl'  value n = composeN n $ onArray value $ S.scan (Fold.foldl' (+) 0)+scanl'  value n = composeN n $ onArray value $ S.scanl (Scanl.mkScanl (+) 0) scanl1' value n = composeN n $ onArray value $ Stream.scanl1' (+) map     value n = composeN n $ onArray value $ fmap (+1) -- map           n = composeN n $ A.map (+1)@@ -149,7 +149,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeN" (S.fold (A.writeN value))+            benchFold "writeN" (S.fold (A.createOf value))                 (P.sourceUnfoldrM value)          ]     ]
benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs view
@@ -6,6 +6,7 @@ import System.Random (randomRIO)  import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl import qualified Streamly.Data.Stream as S import qualified Streamly.Internal.Data.Stream as Stream
benchmark/Streamly/Benchmark/Data/Array/Generic.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-}  {-# LANGUAGE CPP #-}@@ -58,7 +57,7 @@ {-# INLINE sourceIntFromToFromStream #-} sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int) sourceIntFromToFromStream value n =-    S.fold A.write $ S.enumerateFromTo n (n + value)+    S.fold A.create $ S.enumerateFromTo n (n + value)  ------------------------------------------------------------------------------- -- Bench groups@@ -77,10 +76,10 @@ o_1_space_elimination :: Int -> [Benchmark] o_1_space_elimination value =     [ bgroup "elimination"-        [ benchFold "writeLastN.1"-            (S.fold (IA.writeLastN 1)) (P.sourceUnfoldrM value)-        , benchFold "writeLastN.10"-            (S.fold (IA.writeLastN 10)) (P.sourceUnfoldrM value)+        [ benchFold "createOfLast.1"+            (S.fold (IA.createOfLast 1)) (P.sourceUnfoldrM value)+        , benchFold "createOfLast.10"+            (S.fold (IA.createOfLast 10)) (P.sourceUnfoldrM value) #ifdef DEVBUILD {-           benchPureSink value "foldable/foldl'" foldableFoldl'@@ -95,7 +94,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeLastN.Max" (S.fold (IA.writeLastN (value + 1)))+            benchFold "createOfLast.Max" (S.fold (IA.createOfLast (value + 1)))                 (P.sourceUnfoldrM value)          ]     ]
benchmark/Streamly/Benchmark/Data/Array/Stream.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Benchmark.Data.ParserD@@ -39,7 +38,6 @@  import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Array.Stream as ArrayStream import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Stream as Stream@@ -138,7 +136,7 @@ toChunksSplitOnSuffix :: Handle -> IO Int toChunksSplitOnSuffix =     Stream.fold Fold.length-        . ArrayStream.splitOnSuffix 10+        . Array.compactEndByByte_ 10         . Handle.readChunks  #ifdef INSPECTION@@ -151,7 +149,7 @@ toChunksSplitOn :: Handle -> IO Int toChunksSplitOn =     Stream.fold Fold.length-        . ArrayStream.splitOn 32+        . Array.compactSepByByte_ 32         . Handle.readChunks  #ifdef INSPECTION@@ -190,7 +188,7 @@ copyChunksSplitInterposeSuffix :: Handle -> Handle -> IO () copyChunksSplitInterposeSuffix inh outh =     Stream.fold (Handle.write outh)-        $ ArrayStream.interposeSuffix 10 . ArrayStream.splitOnSuffix 10+        $ Array.concatEndBy 10 . Array.compactEndByByte_ 10         $ Handle.readChunks inh  #ifdef INSPECTION@@ -204,7 +202,7 @@ copyChunksSplitInterpose inh outh =     Stream.fold (Handle.write outh)         -- XXX this is not correct word splitting combinator-        $ ArrayStream.interpose 32 . ArrayStream.splitOn 32+        $ Array.concatSepBy 32 . Array.compactSepByByte_ 32         $ Handle.readChunks inh  #ifdef INSPECTION@@ -236,23 +234,25 @@  {-# INLINE fold #-} fold :: Stream IO (Array.Array Int) -> IO ()-fold s = void $ ArrayStream.foldBreak Fold.drain $ StreamK.fromStream s+fold s = void $ Array.foldBreak Fold.drain $ StreamK.fromStream s  {-# INLINE parse #-} parse :: Int -> Stream IO (Array.Array Int) -> IO () parse value s =-    void $ ArrayStream.parseBreak (drainWhile (< value)) $ StreamK.fromStream s+    void $ Array.parseBreak+            (Array.toParserK (drainWhile (< value)))+            (StreamK.fromStream s)  {-# INLINE foldBreak #-} foldBreak :: StreamK IO (Array.Array Int) -> IO () foldBreak s = do-    (r, s1) <- ArrayStream.foldBreak Fold.one s+    (r, s1) <- Array.foldBreak Fold.one s     when (isJust r) $ foldBreak s1  {-# INLINE parseBreak #-} parseBreak :: StreamK IO (Array.Array Int) -> IO () parseBreak s = do-    r <- ArrayStream.parseBreak Parser.one s+    r <- Array.parseBreak (Array.toParserK Parser.one) s     case r of         (Left _, _) -> return ()         (Right _, s1) -> parseBreak s1@@ -295,8 +295,8 @@         then return  (undefined, undefined)         else             do-            small <- Stream.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0-            big <- Stream.toList $ Stream.chunksOf value $ sourceUnfoldrM value 0+            small <- Stream.toList $ Array.chunksOf 100 $ sourceUnfoldrM value 0+            big <- Stream.toList $ Array.chunksOf value $ sourceUnfoldrM value 0             return (small, big)      allBenchmarks env arrays value =
benchmark/Streamly/Benchmark/Data/Fold.hs view
@@ -5,11 +5,11 @@ -- License     : MIT -- Maintainer  : streamly@composewell.com +{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-}  #undef FUSION_CHECK@@ -17,34 +17,60 @@ {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} #endif +#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif+ module Main (main) where  import Control.DeepSeq (NFData(..)) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (ord)+import Streamly.Internal.Data.Array (Array) import Data.Functor.Identity (Identity(..)) import Data.Map.Strict (Map)-import Data.Hashable (Hashable)-import Data.HashMap.Strict (HashMap) import Data.IntMap.Strict (IntMap) import Data.Monoid (Last(..), Sum(..))+import Data.Word (Word8)+import System.IO (Handle) import System.Random (randomRIO)  import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Fold (Fold(..))-import Streamly.Internal.Data.IsMap.HashMap () import Streamly.Internal.Data.MutArray (MutArray) +import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Data.Fold.Prelude as Fold-import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Pipe as Pipe+-- import qualified Streamly.Internal.Data.Scan as Scan import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode -import Test.Tasty.Bench+import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common-import Prelude hiding (all, any, take, unzip, sequence_, filter)+import Streamly.Benchmark.Common.Handle+import Prelude hiding (last, length, all, any, take, unzip, sequence_, filter) +#ifdef INSPECTION+import Streamly.Internal.Data.Stream (Step(..))++import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Unfold as Unfold++import Test.Inspection+#endif+ -- We need a monadic bind here to make sure that the function f does not get -- completely optimized out by the compiler in some cases. @@ -104,27 +130,19 @@  {-# INLINE scanMaybe #-} scanMaybe :: Monad m => Int -> Stream m Int -> m ()-scanMaybe _ = Stream.fold (FL.scanMaybe (FL.filtering even) FL.drain)+scanMaybe _ = Stream.fold (FL.postscanlMaybe (Scanl.filtering even) FL.drain)  {-# INLINE scanMaybe2 #-} scanMaybe2 :: Monad m => Int -> Stream m Int -> m () scanMaybe2 _ =     Stream.fold-        $ FL.scanMaybe (FL.filtering even)-        $ FL.scanMaybe (FL.filtering odd) FL.drain+        $ FL.postscanlMaybe (Scanl.filtering even)+        $ FL.postscanlMaybe (Scanl.filtering odd) FL.drain  ---------------------------------------------------------------------------------- Splitting by serial application+-- Splitting in two ------------------------------------------------------------------------------- -{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()-takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)--{-# INLINE many #-}-many :: Monad m => Stream m Int -> m ()-many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)- {-# INLINE splitAllAny #-} splitAllAny :: Monad m => Int -> Stream m Int -> m (Bool, Bool) splitAllAny value =@@ -158,6 +176,201 @@     when (r /= 0) $ foldBreak s1  -------------------------------------------------------------------------------+-- Split generated streams (not a file)+-------------------------------------------------------------------------------++{-# INLINE many #-}+many :: Monad m => Stream m Int -> m ()+many = Stream.fold (FL.many (FL.take 1 FL.drain) FL.drain)++{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => Int -> Stream m Int -> m ()+takeEndBy_ value = Stream.fold (FL.takeEndBy_ (>= value) FL.drain)++-------------------------------------------------------------------------------+-- Splitting a file stream into a stream by serial application+-------------------------------------------------------------------------------++lf :: Word8+lf = fromIntegral (ord '\n')++toarr :: String -> Array Word8+toarr = Array.fromList . map (fromIntegral . ord)++-- | Split on line feed.+fileInfixTakeEndBy_ :: Handle -> IO Int+fileInfixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (FL.takeEndBy_ (== lf) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileInfixTakeEndBy_+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''Step+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileInfixTakeEndBy_ `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Split on line feed.+fileSuffixTakeEndBy_ :: Handle -> IO Int+fileSuffixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.foldMany+            (Fold.takeEndBy_ (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileSuffixTakeEndBy_+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''Step+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileSuffixTakeEndBy_ `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Split on line feed.+parseFileSuffixTakeEndBy_ :: Handle -> IO Int+parseFileSuffixTakeEndBy_ inh =+    Stream.fold Fold.length+        $ Stream.parseMany+            (Parser.fromFold $ Fold.takeEndBy_ (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++-- | Split suffix with line feed.+fileSuffixTakeEndBy :: Handle -> IO Int+fileSuffixTakeEndBy inh =+    Stream.fold Fold.length+        $ Stream.foldMany+            (Fold.takeEndBy (== lf) Fold.drain)+            (Handle.read inh)+     -- >>= print++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'fileSuffixTakeEndBy+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''Step+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'fileSuffixTakeEndBy `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read+#endif++-- | Infix split on a word8 sequence.+splitOnSeq :: String -> Handle -> IO Int+splitOnSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSeq+-- inspect $ 'splitOnSeq `hasNoType` ''Step+#endif++-- | Infix split on a word8 sequence.+splitOnSeq100k :: Handle -> IO Int+splitOnSeq100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ arr Fold.drain)+        $ Handle.read inh -- >>= print++-- | Split on suffix sequence.+splitOnSuffixSeq :: String -> Handle -> IO Int+splitOnSuffixSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldMany (Fold.takeEndBySeq_ (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++#ifdef INSPECTION+-- inspect $ hasNoTypeClasses 'splitOnSuffixSeq+-- inspect $ 'splitOnSuffixSeq `hasNoType` ''Step+#endif++-- | Split on suffix sequence.+splitWithSuffixSeq :: String -> Handle -> IO Int+splitWithSuffixSeq str inh =+    Stream.fold Fold.length+        $ Stream.foldMany (Fold.takeEndBySeq (toarr str) Fold.drain)+        $ Handle.read inh -- >>= print++o_1_space_reduce_read_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_read_split env =+    -- NOTE: keep the benchmark names consistent with Data.Stream.split*+    [ bgroup "FileSplitElem"+        -- Splitting on single element+        [+          mkBench "takeEndBy_ infix (splitOn)" env $ \inh _ ->+            fileInfixTakeEndBy_ inh+        , mkBench "takeEndBy_ suffix (splitOnSuffix)" env $ \inh _ ->+            fileSuffixTakeEndBy_ inh+        , mkBench "takeEndBy_ suffix parseMany (splitOnSuffix)" env+            $ \inh _ -> parseFileSuffixTakeEndBy_ inh+        , mkBench "takeEndBy suffix (splitWithSuffix)" env $ \inh _ ->+            fileSuffixTakeEndBy inh+        ]++    -- Splitting on sequence+    , bgroup "FileSplitSeq"+        [+          -- Infix takeEndBySeq_+          mkBench "takeEndBySeq_ infix empty pattern" env $ \inh _ ->+            splitOnSeq "" inh+        , mkBench "takeEndBySeq_ infix lf" env $ \inh _ ->+            splitOnSeq "\n" inh+        , mkBench "takeEndBySeq_ infix a" env $ \inh _ ->+            splitOnSeq "a" inh+        , mkBench "takeEndBySeq_ infix crlf" env $ \inh _ ->+            splitOnSeq "\r\n" inh+        , mkBench "takeEndBySeq_ infix aa" env $ \inh _ ->+            splitOnSeq "aa" inh+        , mkBench "takeEndBySeq_ infix aaaa" env $ \inh _ ->+            splitOnSeq "aaaa" inh+        , mkBench "takeEndBySeq_ infix abcdefgh" env $ \inh _ ->+            splitOnSeq "abcdefgh" inh+        , mkBench "takeEndBySeq_ infix abcdefghi" env $ \inh _ ->+            splitOnSeq "abcdefghi" inh+        , mkBench "takeEndBySeq_ infix catcatcatcatcat" env $ \inh _ ->+            splitOnSeq "catcatcatcatcat" inh+        , mkBench "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq_ infix 100k long pattern"+            env $ \inh _ -> splitOnSeq100k inh++          -- Suffix takeEndBySeq_+        , mkBench "takeEndBySeq_ suffix empty pattern" env $ \inh _ ->+            splitOnSuffixSeq "" inh+        , mkBench "takeEndBySeq_ suffix lf" env $ \inh _ ->+            splitOnSuffixSeq "\n" inh+        , mkBench "takeEndBySeq_ suffix crlf" env $ \inh _ ->+            splitOnSuffixSeq "\r\n" inh+        , mkBenchSmall "takeEndBySeq_ suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh++          -- Suffix takeEndBySeq+        , mkBench "takeEndBySeq suffix crlf" env $ \inh _ ->+            splitWithSuffixSeq "\r\n" inh+        , mkBenchSmall "takeEndBySeq suffix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh+        ]+    ]++-- | Infix split on a character sequence.+splitOnSeqUtf8 :: String -> Handle -> IO Int+splitOnSeqUtf8 str inh =+    Stream.fold Fold.length+        $ Stream.foldManyPost (Fold.takeEndBySeq_ (Array.fromList str) Fold.drain)+        $ Unicode.decodeUtf8Chunks+        $ Handle.readChunks inh -- >>= print++o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark]+o_1_space_reduce_toChunks_split env =+    [ bgroup "FileSplitSeqUtf8"+        [ mkBenchSmall "takeEndBySeq_ infix abcdefgh"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh+        , mkBenchSmall "takeEndBySeq_ infix abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh+        ]+    ]++------------------------------------------------------------------------------- -- Distributing by parallel application ------------------------------------------------------------------------------- @@ -210,28 +423,18 @@  {-# INLINE demuxToMap  #-} demuxToMap :: (Monad m, Ord k) =>-    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)-demuxToMap f g = Stream.fold (FL.demuxToContainer f g)+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Stream m a -> m (Map k b)+demuxToMap f g = Stream.fold (FL.demuxerToContainer f g)  {-# INLINE demuxToIntMap  #-} demuxToIntMap :: Monad m =>-    (a -> Int) -> (a -> m (Fold m a b)) -> Stream m a -> m (IntMap b)-demuxToIntMap f g = Stream.fold (FL.demuxToContainer f g)--{-# INLINE demuxToHashMap  #-}-demuxToHashMap :: (Monad m, Hashable k) =>-    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)-demuxToHashMap f g = Stream.fold (FL.demuxToContainer f g)+    (a -> Int) -> (Int -> m (Maybe (Fold m a b))) -> Stream m a -> m (IntMap b)+demuxToIntMap f g = Stream.fold (FL.demuxerToContainer f g)  {-# INLINE demuxToMapIO  #-} demuxToMapIO :: (MonadIO m, Ord k) =>-    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (Map k b)-demuxToMapIO f g = Stream.fold (FL.demuxToContainerIO f g)--{-# INLINE demuxToHashMapIO  #-}-demuxToHashMapIO :: (MonadIO m, Hashable k) =>-    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)-demuxToHashMapIO f g = Stream.fold (FL.demuxToContainerIO f g)+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Stream m a -> m (Map k b)+demuxToMapIO f g = Stream.fold (FL.demuxerToContainerIO f g)  {-# INLINE toMap #-} toMap ::@@ -253,11 +456,6 @@        (MonadIO m, Num a) => (a -> Int) -> Stream m a -> m (IntMap a) toIntMapIO f = Stream.fold (FL.toContainerIO f FL.sum) -{-# INLINE toHashMapIO #-}-toHashMapIO :: (MonadIO m, Ord k, Num a, Hashable k) =>-    (a -> k) -> Stream m a -> m (HashMap k a)-toHashMapIO f = Stream.fold (Fold.toHashMapIO f FL.sum)- ------------------------------------------------------------------------------- -- unzip -------------------------------------------------------------------------------@@ -308,9 +506,9 @@ o_1_space_serial_elimination value =     [ bgroup "elimination"         [ benchIOSink value "drain" (Stream.fold FL.drain)-        , benchIOSink value "drainBy" (Stream.fold (FL.drainBy return))+        , benchIOSink value "drainBy" (Stream.fold (FL.drainMapM return))         , benchIOSink value "drainN" (Stream.fold (FL.drainN value))-        , benchIOSink value "last" (Stream.fold FL.last)+        , benchIOSink value "last" (Stream.fold FL.latest)         , benchIOSink value "length" (Stream.fold FL.length)         , benchIOSink value "top" (Stream.fold $ FL.top 10)         , benchIOSink value "bottom" (Stream.fold $ FL.bottom 10)@@ -325,6 +523,11 @@               value               "mean"               (Stream.fold FL.mean . fmap (fromIntegral :: Int -> Double))+{-+        -- These are already benchmarked in streamly-statistics package. If we+        -- still want to keep these tests here, perhaps we should move them to a+        -- different module so we can remove -fno-warn-warnings-deprecations.+         , benchIOSink               value               "variance"@@ -333,6 +536,7 @@               value               "stdDev"               (Stream.fold FL.stdDev . fmap (fromIntegral :: Int -> Double))+-}         , benchIOSink               value               "mconcat"@@ -346,7 +550,7 @@               "foldMapM"               (Stream.fold (FL.foldMapM (return . Last . Just)))         , benchIOSink value "index" (Stream.fold (FL.index (value + 1)))-        , benchIOSink value "head" (Stream.fold FL.head)+        -- , benchIOSink value "head" (Stream.fold FL.head)         , benchIOSink value "find" (Stream.fold (FL.find (== (value + 1))))         , benchIOSink               value@@ -360,7 +564,7 @@               value               "elemIndex"               (Stream.fold (FL.elemIndex (value + 1)))-        , benchIOSink value "null" (Stream.fold FL.null)+        -- , benchIOSink value "null" (Stream.fold FL.null)         , benchIOSink value "elem" (Stream.fold (FL.elem (value + 1)))         , benchIOSink value "notElem" (Stream.fold (FL.notElem (value + 1)))         , benchIOSink value "all" $ all value@@ -388,21 +592,30 @@               value               "pipe-mapM"               (Stream.fold-                   (FL.transform+                   (FL.pipe                         (Pipe.mapM (\x -> return $ x + 1))                         FL.drain))+{-         , benchIOSink+              value+              "fold-runScan"+              (Stream.fold+                   (FL.runScan+                        (Scan.functionM (\x -> return $ x + 1))+                        FL.drain))+-}+        , benchIOSink             value             "fold-scan"-            (Stream.fold $ FL.scan FL.sum FL.drain)+            (Stream.fold $ FL.scanl Scanl.sum FL.drain)         , benchIOSink             value             "fold-scanMany"-            (Stream.fold $ FL.scanMany (FL.take 2 FL.drain) FL.drain)+            (Stream.fold $ FL.scanlMany (Scanl.take 2 Scanl.drain) FL.drain)         , benchIOSink             value             "fold-postscan"-            (Stream.fold $ FL.postscan FL.sum FL.drain)+            (Stream.fold $ FL.postscanl Scanl.sum FL.drain)         ]     ] @@ -458,15 +671,11 @@     , bgroup "key-value"             [               benchIOSink value "demuxToMap (64 buckets) [sum, length]"-                $ demuxToMap (getKey 64) (getFold . getKey 64)+                $ demuxToMap (getKey 64) getFold             , benchIOSink value "demuxToIntMap (64 buckets) [sum, length]"-                $ demuxToIntMap (getKey 64) (getFold . getKey 64)-            , benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"-                $ demuxToHashMap (getKey 64) (getFold . getKey 64)+                $ demuxToIntMap (getKey 64) getFold             , benchIOSink value "demuxToMapIO (64 buckets) [sum, length]"-                $ demuxToMapIO (getKey 64) (getFold . getKey 64)-            , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"-                $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)+                $ demuxToMapIO (getKey 64) getFold              -- classify: immutable             , benchIOSink value "toMap (64 buckets) sum"@@ -483,12 +692,6 @@                 $ toMapIO (getKey value)             , benchIOSink value "toIntMapIO (64 buckets) sum"                 $ toIntMapIO (getKey 64)-            , benchIOSink value "toHashMapIO (single bucket) sum"-                $ toHashMapIO (getKey 1)-            , benchIOSink value "toHashMapIO (64 buckets) sum"-                $ toHashMapIO (getKey 64)-            , benchIOSink value "toHashMapIO (max buckets) sum"-                $ toHashMapIO (getKey value)             ]     ] @@ -497,7 +700,7 @@     getKey buckets = (`mod` buckets)      getFold k =-        return $ case k of+        return $ Just $ case k of             0 -> FL.sum             1 -> FL.length             _ -> FL.length@@ -509,15 +712,18 @@ main :: IO () main = do #ifndef FUSION_CHECK-    runWithCLIOpts defaultStreamSize allBenchmarks+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)      where -    allBenchmarks value =+    allBenchmarks env value =         [ bgroup (o_1_space_prefix moduleName) $ concat             [ o_1_space_serial_elimination value             , o_1_space_serial_transformation value             , o_1_space_serial_composition value+            , o_1_space_reduce_read_split env+            , o_1_space_reduce_toChunks_split env             ]         , bgroup (o_n_space_prefix moduleName) (o_n_space_serial value)         , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)
+ benchmark/Streamly/Benchmark/Data/Fold/Prelood.hs view
@@ -0,0 +1,172 @@+-- |+-- Module      : Streamly.Benchmark.Data.Fold.Prelude+-- Copyright   : (c) 2018 Composewell+--+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#undef FUSION_CHECK+#ifdef FUSION_CHECK+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}+#endif++module Main (main) where++import Control.DeepSeq (NFData(..))+import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import Data.Hashable (Hashable)+import Data.HashMap.Strict (HashMap)+import System.Random (randomRIO)++import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.IsMap.HashMap ()+import Streamly.Internal.Data.MutArray (MutArray)++import qualified Streamly.Data.Fold.Prelude as Fold+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Streamly.Benchmark.Common.Handle++-- We need a monadic bind here to make sure that the function f does not get+-- completely optimized out by the compiler in some cases.++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrM value n = Stream.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE source #-}+source :: Monad m => Int -> Int -> Stream m Int+source = sourceUnfoldrM++-- | Takes a fold method, and uses it with a default source.+{-# INLINE benchIOSink #-}+benchIOSink+    :: NFData b+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSink value name f = bench name $ nfIO $ randomRIO (1,1) >>= f . source value++-------------------------------------------------------------------------------+-- Partitioning+-------------------------------------------------------------------------------++{-# INLINE demuxToHashMap  #-}+demuxToHashMap :: (Monad m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)+demuxToHashMap f g = Stream.fold (Fold.demuxToContainer f g)++{-# INLINE demuxToHashMapIO  #-}+demuxToHashMapIO :: (MonadIO m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> (a -> m (Fold m a b)) -> Stream m a -> m (HashMap k b)+demuxToHashMapIO f g = Stream.fold (Fold.demuxToContainerIO f g)++{-# INLINE toHashMapIO #-}+toHashMapIO :: (MonadIO m, Num a, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>+    (a -> k) -> Stream m a -> m (HashMap k a)+toHashMapIO f = Stream.fold (Fold.toHashMapIO f Fold.sum)++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Fold.Prelude"++instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) xs++o_n_heap_serial :: Int -> [Benchmark]+o_n_heap_serial value =+    [ bgroup "key-value"+            [+              benchIOSink value "demuxToHashMap (64 buckets) [sum, length]"+                $ demuxToHashMap (getKey 64) (getFold . getKey 64)+            , benchIOSink value "demuxToHashMapIO (64 buckets) [sum, length]"+                $ demuxToHashMapIO (getKey 64) (getFold . getKey 64)++            -- classify: mutable cells+            , benchIOSink value "toHashMapIO (single bucket) sum"+                $ toHashMapIO (getKey 1)+            , benchIOSink value "toHashMapIO (64 buckets) sum"+                $ toHashMapIO (getKey 64)+            , benchIOSink value "toHashMapIO (max buckets) sum"+                $ toHashMapIO (getKey value)+            ]+    ]++    where++    getKey buckets = (`mod` buckets)++    getFold k =+        return $ case k of+            0 -> Fold.sum+            1 -> Fold.length+            _ -> Fold.length++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = do+#ifndef FUSION_CHECK+    env <- mkHandleBenchEnv+    runWithCLIOpts defaultStreamSize (allBenchmarks env)++    where++    allBenchmarks _env value =+        [ bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)+        ]+#else+    -- Enable FUSION_CHECK macro at the beginning of the file+    -- Enable one benchmark below, and run the benchmark+    -- Check the .dump-simpl output+    let value = 100000+    let input = source value 1+    let getKey buckets = (`mod` buckets)+    let getFold k =+            return $ case k of+                0 -> Fold.sum+                1 -> Fold.length+                _ -> Fold.length++    -- demuxToMap (getKey 64) (getFold . getKey 64) input+    toIntMapIO (getKey 64) input+    return ()+#endif
benchmark/Streamly/Benchmark/Data/Fold/Window.hs view
@@ -9,7 +9,7 @@  import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.Data.Fold as Window-import qualified Streamly.Internal.Data.Ring as Ring+import qualified Streamly.Internal.Data.RingArray as RingArray import qualified Streamly.Internal.Data.Stream as Stream  import Streamly.Benchmark.Common@@ -94,29 +94,29 @@             (Window.windowRange 1000)          , benchWithFoldInt numElements "sumInt (window size 100)"-            (Ring.slidingWindow 100 Window.windowSumInt)+            (RingArray.slidingWindow 100 Window.windowSumInt)         , benchWithFoldInt numElements "sum for Int (window size 100)"-            (Ring.slidingWindow 100 Window.windowSum)+            (RingArray.slidingWindow 100 Window.windowSum)         , benchWithFold numElements "sum (window size 100)"-            (Ring.slidingWindow 100 Window.windowSum)+            (RingArray.slidingWindow 100 Window.windowSum)         , benchWithFold numElements "sum (window size 1000)"-            (Ring.slidingWindow 1000 Window.windowSum)+            (RingArray.slidingWindow 1000 Window.windowSum)         , benchWithFold numElements "sum (entire stream)"             (Window.cumulative Window.windowSum)         , benchWithFold numElements "sum (Data.Fold)"             Fold.sum          , benchWithFold numElements "mean (window size 100)"-            (Ring.slidingWindow 100 Window.windowMean)+            (RingArray.slidingWindow 100 Window.windowMean)         , benchWithFold numElements "mean (window size 1000)"-            (Ring.slidingWindow 1000 Window.windowMean)+            (RingArray.slidingWindow 1000 Window.windowMean)         , benchWithFold numElements "mean (entire stream)"             (Window.cumulative Window.windowMean)         , benchWithFold numElements "mean (Data.Fold)"             Fold.mean          , benchWithFold numElements "powerSum 2 (window size 100)"-            (Ring.slidingWindow 100 (Window.windowPowerSum 2))+            (RingArray.slidingWindow 100 (Window.windowPowerSum 2))         , benchWithFold numElements "powerSum 2 (entire stream)"             (Window.cumulative (Window.windowPowerSum 2)) @@ -159,19 +159,19 @@             (Window.windowRange 1000)          , benchWithPostscan numElements "sum (window size 100)"-            (Ring.slidingWindow 100 Window.windowSum)+            (RingArray.slidingWindow 100 Window.windowSum)         , benchWithPostscan numElements "sum (window size 1000)"-            (Ring.slidingWindow 1000 Window.windowSum)+            (RingArray.slidingWindow 1000 Window.windowSum)          , benchWithPostscan numElements "mean (window size 100)"-            (Ring.slidingWindow 100 Window.windowMean)+            (RingArray.slidingWindow 100 Window.windowMean)         , benchWithPostscan numElements "mean (window size 1000)"-            (Ring.slidingWindow 1000 Window.windowMean)+            (RingArray.slidingWindow 1000 Window.windowMean)          , benchWithPostscan numElements "powerSum 2 (window size 100)"-            (Ring.slidingWindow 100 (Window.windowPowerSum 2))+            (RingArray.slidingWindow 100 (Window.windowPowerSum 2))         , benchWithPostscan numElements "powerSum 2 (window size 1000)"-            (Ring.slidingWindow 1000 (Window.windowPowerSum 2))+            (RingArray.slidingWindow 1000 (Window.windowPowerSum 2))         ]     ]
benchmark/Streamly/Benchmark/Data/MutArray.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans #-}  -- |@@ -23,6 +22,9 @@ import Control.DeepSeq (NFData(..)) import Control.Monad.IO.Class (MonadIO) import Data.Functor ((<&>))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif import System.Random (randomRIO) import Prelude     ( IO@@ -47,11 +49,15 @@ import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl import qualified Streamly.Internal.Data.Stream as Stream  import Test.Tasty.Bench import Streamly.Benchmark.Common hiding (benchPureSrc) +#if __GLASGOW_HASKELL__ >= 810+type Stream :: Type -> Type+#endif type Stream = MutArray  instance NFData (MutArray a) where@@ -95,7 +101,7 @@ {-# INLINE sourceUnfoldr #-} sourceUnfoldr :: MonadIO m => Int -> Int -> m (Stream Int) sourceUnfoldr value n =-    Stream.fold (MArray.writeN value) $ Stream.unfoldr step n+    Stream.fold (MArray.createOf value) $ Stream.unfoldr step n      where @@ -107,12 +113,12 @@ {-# INLINE sourceIntFromTo #-} sourceIntFromTo :: MonadIO m => Int -> Int -> m (Stream Int) sourceIntFromTo value n =-    Stream.fold (MArray.writeN value) $ Stream.enumerateFromTo n (n + value)+    Stream.fold (MArray.createOf value) $ Stream.enumerateFromTo n (n + value)  {-# INLINE sourceFromList #-} sourceFromList :: MonadIO m => Int -> Int -> m (Stream Int) sourceFromList value n =-    Stream.fold (MArray.writeN value) $ Stream.fromList [n .. n + value]+    Stream.fold (MArray.createOf value) $ Stream.fromList [n .. n + value]  {-# INLINE sourceIntFromToFromList #-} sourceIntFromToFromList :: MonadIO m => Int -> Int -> m (Stream Int)@@ -121,7 +127,7 @@ {-# INLINE sourceIntFromToFromStream #-} sourceIntFromToFromStream :: MonadIO m => Int -> Int -> m (Stream Int) sourceIntFromToFromStream value n =-    Stream.fold MArray.write $ Stream.enumerateFromTo n (n + value)+    Stream.fold MArray.create $ Stream.enumerateFromTo n (n + value)  {-# INLINE sourceUnfoldrM #-} sourceUnfoldrM :: Monad m => Int -> Int -> Stream.Stream m Int@@ -149,7 +155,7 @@  {-# INLINE scanl' #-} scanl' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)-scanl' value n = composeN n $ onArray value $ Stream.scan (Fold.foldl' (+) 0)+scanl' value n = composeN n $ onArray value $ Stream.scanl (Scanl.mkScanl (+) 0)  {-# INLINE scanl1' #-} scanl1' :: MonadIO m => Int -> Int -> Stream Int -> m (Stream Int)@@ -165,7 +171,7 @@     -> Stream Int     -> m (Stream Int) onArray value f arr =-    Stream.fold (MArray.writeN value) $ f $ Stream.unfold MArray.reader arr+    Stream.fold (MArray.createOf value) $ f $ Stream.unfold MArray.reader arr  ------------------------------------------------------------------------------- -- Elimination@@ -199,12 +205,12 @@ o_1_space_generation value =     [ bgroup         "generation"-        [ benchIOSrc "writeN . intFromTo" (sourceIntFromTo value)+        [ benchIOSrc "createOf . intFromTo" (sourceIntFromTo value)         , benchIOSrc               "fromList . intFromTo"               (sourceIntFromToFromList value)-        , benchIOSrc "writeN . unfoldr" (sourceUnfoldr value)-        , benchIOSrc "writeN . fromList" (sourceFromList value)+        , benchIOSrc "createOf . unfoldr" (sourceUnfoldr value)+        , benchIOSrc "createOf . fromList" (sourceFromList value)         , benchIOSrc "write . intFromTo" (sourceIntFromToFromStream value)         ]     ]@@ -226,7 +232,7 @@     [ bgroup "elimination"         [         -- Converting the stream to an array-            benchFold "writeN" (Stream.fold (MArray.writeN value))+            benchFold "createOf" (Stream.fold (MArray.createOf value))                 (sourceUnfoldrM value)          ]     ]@@ -261,9 +267,9 @@     , benchIO' "partitionBy (> value/2)" (const (return array))         $ MArray.partitionBy (> (value `div` 2))     , benchIO' "strip (< value/2 || > value/2)" (const (return array))-        $ MArray.strip (\x -> x < value `div` 2 || x > value `div` 2)+        $ MArray.dropAround (\x -> x < value `div` 2 || x > value `div` 2)     , benchIO' "strip (> 0)" (const (return array))-        $ MArray.strip (> 0)+        $ MArray.dropAround (> 0)     , benchIO' "modifyIndices (+ 1)" (const (return indices))         $ Stream.fold (MArray.modifyIndices array (\_idx val -> val + 1))         . Stream.unfold Array.reader
benchmark/Streamly/Benchmark/Data/Parser.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  #undef FUSION_CHECK #ifdef FUSION_CHECK@@ -33,7 +32,7 @@ import System.Random (randomRIO) import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Internal.Data.Parser-    (ParseError(..), Parser(..), Initial(..), Step(..))+    (ParseError(..), Parser(..), Initial(..), Step(..), Final(..)) import Streamly.Internal.Data.Stream (Stream) import Prelude hiding     (any, all, take, sequence, sequence_, sequenceA, takeWhile, dropWhile, span)@@ -136,11 +135,11 @@ dropWhile :: Monad m => Int -> Stream m Int -> m (Either ParseError ()) dropWhile value = Stream.parse (PR.dropWhile (<= value)) -{-# INLINE takeStartBy #-}-takeStartBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())-takeStartBy value stream = do+{-# INLINE takeBeginBy #-}+takeBeginBy :: Monad m => Int -> Stream m Int -> m (Either ParseError ())+takeBeginBy value stream = do     let stream2 = value `Stream.cons` stream-    Stream.parse (PR.takeStartBy (== value) Fold.drain) stream2+    Stream.parse (PR.takeBeginBy (== value) Fold.drain) stream2  takeFramedByEsc_ :: Monad m => Int -> Stream m Char -> m (Either ParseError ()) takeFramedByEsc_ _ = Stream.parse parser@@ -365,11 +364,11 @@             fres <- fstep s a             return                 $ case fres of-                      Fold.Partial s1 -> Partial 0 s1-                      Fold.Done b -> Done 0 b-        else return $ Error "fail"+                      Fold.Partial s1 -> SPartial 1 s1+                      Fold.Done b -> SDone 1 b+        else return $ SError "fail" -    extract s = fmap (Done 0) (ffinal s)+    extract s = fmap (FDone 0) (ffinal s)  {-# INLINE alt2 #-} alt2 :: Monad m@@ -718,7 +717,7 @@     , benchIOSink value "takeWhileP" $ takeWhileP value     , benchIOSink value "takeP" $ takeP value     , benchIOSink value "dropWhile" $ dropWhile value-    , benchIOSink value "takeStartBy" $ takeStartBy value+    , benchIOSink value "takeBeginBy" $ takeBeginBy value     , benchIOSink value "takeEndBy_" $ takeEndBy_ value     , benchIOSink value "groupBy" $ groupBy     , benchIOSink value "groupByRolling" $ groupByRolling@@ -856,7 +855,7 @@      where -    alloc value = Stream.fold Fold.toList $ Stream.chunksOf 100 $ sourceUnfoldrM value 0+    alloc value = Stream.fold Fold.toList $ Array.chunksOf 100 $ sourceUnfoldrM value 0      allBenchmarks env arrays value =         [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)
benchmark/Streamly/Benchmark/Data/ParserK.hs view
@@ -5,9 +5,9 @@ -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com --- BENCH_CHUNKED             -> adaptC--- BENCH_CHUNKED_GENERIC     -> adaptCG--- BENCH_SINGULAR            -> adapt+-- BENCH_CHUNKED             -> parse from Array stream+-- BENCH_CHUNKED_GENERIC     -> parse from Generic Array stream+-- BENCH_SINGULAR            -> parse from single element stream  {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}@@ -27,12 +27,11 @@ #endif #ifdef BENCH_CHUNKED_GENERIC import Streamly.Data.Array.Generic (Array)-import qualified Streamly.Internal.Data.Array.Generic as GenArr (chunksOf) #endif import Streamly.Internal.Data.Fold (Fold(..)) import Streamly.Data.StreamK (StreamK) import Streamly.Internal.Data.Parser-    (ParseError(..), Parser(..), Initial(..), Step(..))+    (ParseError(..), Parser(..), Initial(..), Step(..), Final(..)) import Streamly.Internal.Data.Stream (Stream) import System.Random (randomRIO) import Prelude hiding@@ -47,6 +46,11 @@ import qualified Streamly.Data.Parser as PRD import qualified Streamly.Internal.Data.ParserK as PR import qualified Streamly.Internal.Data.StreamK as StreamK+#ifdef BENCH_CHUNKED+import qualified Streamly.Internal.Data.Array as Array+#elif defined(BENCH_CHUNKED_GENERIC)+import qualified Streamly.Internal.Data.Array.Generic as GenArr+#endif  import Test.Tasty.Bench import Streamly.Benchmark.Common@@ -57,8 +61,8 @@  #ifdef BENCH_CHUNKED -#define PARSE_OP StreamK.parseChunks-#define FROM_PARSER adaptC+#define PARSE_OP Array.parse+#define FROM_PARSER Array.toParserK #define INPUT (Array a) #define PARSE_ELEM (Array Int) #define CONSTRAINT_IO (MonadIO m, Unbox a)@@ -69,8 +73,8 @@  #ifdef BENCH_CHUNKED_GENERIC -#define PARSE_OP StreamK.parseChunksGeneric-#define FROM_PARSER adaptCG+#define PARSE_OP GenArr.parse+#define FROM_PARSER GenArr.toParserK #define INPUT (Array a) #define PARSE_ELEM (Array Int) #define CONSTRAINT_IO (MonadIO m)@@ -82,7 +86,7 @@ #ifdef BENCH_SINGULAR  #define PARSE_OP StreamK.parse-#define FROM_PARSER adapt+#define FROM_PARSER PR.toParserK #define INPUT a #define PARSE_ELEM Int #define CONSTRAINT_IO (MonadIO m)@@ -116,7 +120,7 @@         >>= f             . StreamK.fromStream #ifdef BENCH_CHUNKED-            . Stream.chunksOf 4000+            . Array.chunksOf 4000 #endif #ifdef BENCH_CHUNKED_GENERIC             . GenArr.chunksOf 4000@@ -135,18 +139,18 @@     where      p = do-        m <- PR.FROM_PARSER (PRD.fromFold FL.one)+        m <- FROM_PARSER (PRD.fromFold FL.one)         case m of           Just i -> if i >= value then pure m else p           Nothing -> pure Nothing  {-# INLINE satisfy #-} satisfy :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m a-satisfy = PR.FROM_PARSER . PRD.satisfy+satisfy = FROM_PARSER . PRD.satisfy  {-# INLINE takeWhile #-} takeWhile :: CONSTRAINT_IO => (a -> Bool) -> PR.ParserK INPUT m ()-takeWhile p = PR.FROM_PARSER $ PRD.takeWhile p FL.drain+takeWhile p = FROM_PARSER $ PRD.takeWhile p FL.drain  {-# INLINE takeWhileK #-} takeWhileK :: MonadIO m =>@@ -230,16 +234,16 @@             fres <- fstep s a             return                 $ case fres of-                      Fold.Partial s1 -> Partial 0 s1-                      Fold.Done b -> Done 0 b-        else return $ Error "fail"+                      Fold.Partial s1 -> SContinue 1 s1+                      Fold.Done b -> SDone 1 b+        else return $ SError "fail" -    extract s = fmap (Done 0) (ffinal s)+    extract s = fmap (FDone 0) (ffinal s)  {-# INLINE takeWhileFail #-} takeWhileFail :: CONSTRAINT =>     (a -> Bool) -> Fold m a b -> PR.ParserK INPUT m b-takeWhileFail p f = PR.FROM_PARSER (takeWhileFailD p f)+takeWhileFail p f = FROM_PARSER (takeWhileFailD p f)  {-# INLINE alt2 #-} alt2 :: MonadIO m@@ -379,12 +383,8 @@     , benchIOSink value "splitAp2" $ splitAp2 value     , benchIOSink value "splitAp8" $ splitAp8 value     , benchIOSink value "alt2" $ alt2 value-    , benchIOSink value "alt8" $ alt8 value-    , benchIOSink value "alt16" $ alt16 value     , benchIOSink value "monad2" $ monad2 value     , benchIOSink value "monad4" $ monad4 value-    , benchIOSink value "monad8" $ monad8 value-    , benchIOSink value "monad16" $ monad16 value     ]  {-# INLINE sepBy1 #-}@@ -413,6 +413,12 @@     , benchIOSink value "sepBy1" sepBy1     , benchIOSink value "someAlt" someAlt     , benchIOSink value "choice" $ choice value++    -- XXX these take too much memory with --long, need to investigate+    , benchIOSink value "alt8" $ alt8 value+    , benchIOSink value "alt16" $ alt16 value+    , benchIOSink value "monad8" $ monad8 value+    , benchIOSink value "monad16" $ monad16 value     ]  -- O(n) heap beacuse of accumulation of the list in strict IO monad?
− benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hs 
@@ -1,69 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.Ring.Unboxed--- Copyright   : (c) 2022 Composewell--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where--import Control.Monad (void)-import GHC.Ptr (Ptr(..))-import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Ring as Ring-import qualified Data.Foldable as P--import Test.Tasty.Bench-import Streamly.Benchmark.Common--import Prelude as P------------------------------------------------------------------------------------ Benchmark ops----------------------------------------------------------------------------------unsafeEqArrayN :: (Int, Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool-unsafeEqArrayN (value, arr, (ring, rh)) = Ring.unsafeEqArrayN ring rh arr value--unsafeEqArray :: (Array.Array Int, (Ring.Ring Int, Ptr Int)) -> Bool-unsafeEqArray (arr, (ring, rh)) = Ring.unsafeEqArray ring rh arr------------------------------------------------------------------------------------ Benchmark groups----------------------------------------------------------------------------------o_1_space_serial ::-       Int -> Array.Array Int -> (Ring.Ring Int, Ptr Int) -> [Benchmark]-o_1_space_serial value arr (ring, rh) =-    [ bench "unsafeEqArrayN" $ nf unsafeEqArrayN (value, arr, (ring, rh))-    , bench "unsafeEqArray" $ nf unsafeEqArray (arr, (ring, rh))-    ]------------------------------------------------------------------------------------ Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Ring.Unboxed"--main :: IO ()-main = do-    runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks--    where--    alloc value = do-        let input = [1 .. value] :: [Int]-        let arr = Array.fromList input-        (ring, rh) <- Ring.new value-        void $ P.foldlM (Ring.unsafeInsert ring) rh input-        return (arr, (ring, rh))--    allBenchmarks (arr, (ring, rh)) value =-        [ bgroup-              (o_1_space_prefix moduleName)-              (o_1_space_serial value arr (ring, rh))-        ]
+ benchmark/Streamly/Benchmark/Data/RingArray.hs view
@@ -0,0 +1,67 @@+-- |+-- Module      : Streamly.Benchmark.Data.RingArray+-- Copyright   : (c) 2022 Composewell+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.RingArray as RingArray++import Test.Tasty.Bench+import Streamly.Benchmark.Common++import Prelude as P++-------------------------------------------------------------------------------+-- Benchmark ops+-------------------------------------------------------------------------------++eqArrayN :: (Int, Array.Array Int, RingArray.RingArray Int) -> IO Bool+eqArrayN (value, arr, ring) = RingArray.eqArrayN ring arr value++eqArray :: (Array.Array Int, RingArray.RingArray Int) -> IO Bool+eqArray (arr, ring) = RingArray.eqArray ring arr++-------------------------------------------------------------------------------+-- Benchmark groups+-------------------------------------------------------------------------------++o_1_space_serial :: Int -> Array.Array Int -> RingArray.RingArray Int -> [Benchmark]+o_1_space_serial value arr ring =+    [ bench "eqArrayN" $ nfIO $ eqArrayN (value, arr, ring)+    , bench "eqArray" $ nfIO $ eqArray (arr, ring)+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.RingArray"++main :: IO ()+main = do+    runWithCLIOptsEnv defaultStreamSize alloc allBenchmarks++    where++    alloc value = do+        let input = [1 .. value] :: [Int]+        let arr = Array.fromList input+        marr <- MutArray.fromList input+        let ring = maybe (error "cast failed") id (RingArray.castMutArray marr)++        return (arr, ring)++    allBenchmarks (arr, ring) value =+        [ bgroup+              (o_1_space_prefix moduleName)+              (o_1_space_serial value arr ring)+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl.hs view
@@ -0,0 +1,127 @@+-- |+-- Module      : Streamly.Benchmark.Data.Scanl+-- Copyright   : (c) 2018 Composewell+--+-- License     : MIT+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++module Main (main) where++import Data.IORef (newIORef, readIORef, modifyIORef)+import Control.DeepSeq (NFData(..))+import Data.Functor.Identity (Identity(..))+import System.Random (randomRIO)++import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.MutArray (MutArray)++import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as Stream++import Test.Tasty.Bench hiding (env)+import Streamly.Benchmark.Common+import Prelude hiding (last, length, all, any, take, unzip, sequence_, filter)++import qualified Data.Set as Set+import System.IO.Unsafe (unsafePerformIO)++-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE benchScanWith #-}+benchScanWith :: Num a =>+    (Int -> a -> Stream IO a) -> Int -> String -> Scanl IO a b -> Benchmark+benchScanWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int)+            >>= Stream.fold FL.drain+                . Stream.postscanl f+                . src len+                . fromIntegral++{-# INLINE benchWithPostscan #-}+benchWithPostscan :: Int -> String -> Scanl IO Int a -> Benchmark+benchWithPostscan = benchScanWith source++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Scanl"++instance NFData (MutArray a) where+    {-# INLINE rnf #-}+    rnf _ = ()++instance NFData a => NFData (Stream Identity a) where+    {-# INLINE rnf #-}+    rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs++o_1_space_serial :: Int -> [Benchmark]+o_1_space_serial value =+    [ bgroup "key-value"+            [+              benchWithPostscan value "demuxIO (1-shot) (64 buckets) [sum 100]"+                  $ Scanl.demuxIO (getKey 64) getScanl+            , benchWithPostscan value "demuxIO (64 buckets) [sum]"+                  $ Scanl.demuxIO (getKey 64) (const (pure (Just Scanl.sum)))+            , benchWithPostscan value "classifyIO (64 buckets) [sum 100]"+                  $ Scanl.classifyIO (getKey 64) (limitedSum 100)+            , benchWithPostscan value "classifyIO (64 buckets) [sum]"+                  $ Scanl.classifyIO (getKey 64) Scanl.sum+            ]+    ]++    where++    limitedSum n = Scanl.take n Scanl.sum++    getKey buckets = (`mod` buckets)++    afterDone action (Scanl.Scanl step i e f) = Scanl.Scanl step1 i e f+        where+        step1 x a = do+            res <- step x a+            case res of+                Scanl.Partial s1 -> pure $ Scanl.Partial s1+                Scanl.Done b -> action >> pure (Scanl.Done b)++    ref = unsafePerformIO $ newIORef Set.empty+    getScanl k = do+        set <- readIORef ref+        if Set.member k set+        then pure Nothing+        else pure+                 $ Just+                 $ afterDone (modifyIORef ref (Set.insert k)) (limitedSum 100)++-------------------------------------------------------------------------------+-- Driver+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName) (o_1_space_serial value)+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,76 @@+module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Function ((&))+-- import Streamly.Internal.Data.Scanl (Scanl)+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanl.Prelude as Scanl++import Data.IORef+import Streamly.Benchmark.Common+import Test.Tasty.Bench++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Seed = Int++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE mkBench #-}+mkBench :: String -> (Seed -> IO ()) -> Benchmark+mkBench name f =+    bench name $ nfIO $ randomRIO (1, 1 :: Int) >>= f++--------------------------------------------------------------------------------+-- Benchmarks+--------------------------------------------------------------------------------++parDistributeScanM :: Int -> Seed -> IO ()+parDistributeScanM len seed = do+    ref <- newIORef [Scanl.latest]+    let gen = atomicModifyIORef ref (\xs -> ([], xs))+    Scanl.parDistributeScanM id gen (source len seed)+        & Stream.fold Fold.drain++--------------------------------------------------------------------------------+-- Groups+--------------------------------------------------------------------------------++o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans numElements =+    [ bgroup "scan"+        [ mkBench "parDistributeScanM" (parDistributeScanM numElements)+        ]+    ]++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Scanl.Concurrent"++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+            ( o_1_space_scans value+            )+        ]
+ benchmark/Streamly/Benchmark/Data/Scanl/Window.hs view
@@ -0,0 +1,113 @@+module Main (main) where++import Streamly.Internal.Data.Scanl (Scanl)+import Streamly.Internal.Data.Stream (Stream)+import System.Random (randomRIO)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as Stream++import Streamly.Benchmark.Common+import Test.Tasty.Bench++{-# INLINE source #-}+source :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+source len from =+    Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len)++{-# INLINE sourceDescending #-}+sourceDescending :: (Monad m, Num a, Stream.Enumerable a) =>+    Int -> a -> Stream m a+sourceDescending len from =+    Stream.enumerateFromThenTo+        (from + fromIntegral len)+        (from + fromIntegral (len - 1))+        from++{-# INLINE sourceDescendingInt #-}+sourceDescendingInt :: Monad m => Int -> Int -> Stream m Int+sourceDescendingInt = sourceDescending++{-# INLINE benchScanWith #-}+benchScanWith :: Num a =>+    (Int -> a -> Stream IO a) -> Int -> String -> Scanl IO a b -> Benchmark+benchScanWith src len name f =+    bench name+        $ nfIO+        $ randomRIO (1, 1 :: Int)+            >>= Stream.fold Fold.drain+                . Stream.postscanl f+                . src len+                . fromIntegral++{-# INLINE benchWithPostscan #-}+benchWithPostscan :: Int -> String -> Scanl IO Double a -> Benchmark+benchWithPostscan = benchScanWith source++o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans numElements =+    [ bgroup "scan"+        [ benchWithPostscan numElements "minimum (window size 10)"+            (Scanl.windowMinimum 10)+        -- Below window size 30 the linear search based impl performs better+        -- than the dequeue based implementation.+        , benchWithPostscan numElements "minimum (window size 30)"+            (Scanl.windowMinimum 30)+        , benchWithPostscan numElements "minimum (window size 1000)"+            (Scanl.windowMinimum 1000)+        , benchScanWith sourceDescendingInt numElements+            "minimum descending (window size 1000)"+            (Scanl.windowMinimum 1000)++        , benchWithPostscan numElements "maximum (window size 10)"+            (Scanl.windowMaximum 10)+        , benchWithPostscan numElements "maximum (window size 30)"+            (Scanl.windowMaximum 30)+        , benchWithPostscan numElements "maximum (window size 1000)"+            (Scanl.windowMaximum 1000)+        , benchScanWith sourceDescendingInt numElements+            "maximum descending (window size 1000)"+            (Scanl.windowMaximum 1000)++        , benchWithPostscan numElements "range (window size 10)"+            (Scanl.windowRange 10)+        , benchWithPostscan numElements "range (window size 30)"+            (Scanl.windowRange 30)+        , benchWithPostscan numElements "range (window size 1000)"+            (Scanl.windowRange 1000)+        , benchScanWith sourceDescendingInt numElements+            "range descending (window size 1000)"+            (Scanl.windowRange 1000)++        , benchWithPostscan numElements "sum (window size 100)"+            (Scanl.incrScan 100 Scanl.incrSum)+        , benchWithPostscan numElements "sum (window size 1000)"+            (Scanl.incrScan 1000 Scanl.incrSum)++        , benchWithPostscan numElements "mean (window size 100)"+            (Scanl.incrScan 100 Scanl.incrMean)+        , benchWithPostscan numElements "mean (window size 1000)"+            (Scanl.incrScan 1000 Scanl.incrMean)++        , benchWithPostscan numElements "powerSum 2 (window size 100)"+            (Scanl.incrScan 100 (Scanl.incrPowerSum 2))+        , benchWithPostscan numElements "powerSum 2 (window size 1000)"+            (Scanl.incrScan 1000 (Scanl.incrPowerSum 2))+        ]+    ]++moduleName :: String+moduleName = "Data.Scanl.Window"++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+            ( o_1_space_scans value+            )+        ]
benchmark/Streamly/Benchmark/Data/Serialize.hs view
@@ -55,6 +55,11 @@ #define DESERIALIZE_OP deserializeAt #endif +import Prelude hiding (length)+#ifndef USE_UNBOX+import qualified Prelude as P+#endif+ ------------------------------------------------------------------------------- -- Types -------------------------------------------------------------------------------@@ -557,7 +562,7 @@     -- Approximately 100000 constructors, assuming two constructors (Cons, Int)     -- per element.     let lInt = [1..50000 :: Int]-    let !len = length lInt -- evaluate the list+    let !len = P.length lInt -- evaluate the list #endif #ifndef FUSION_CHECK #ifdef USE_UNBOX
benchmark/Streamly/Benchmark/Data/Stream.hs view
@@ -26,7 +26,7 @@ import qualified Stream.Generate as Generation import qualified Stream.Lift as Lift import qualified Stream.Reduce as NestedFold-#ifdef USE_PRELUDE+#ifndef USE_PRELUDE import qualified Stream.Split as Split #endif import qualified Stream.Transform as Transformation@@ -43,11 +43,7 @@ #endif  moduleName :: String-#ifdef USE_STREAMK-moduleName = "Data.Stream.StreamDK"-#else moduleName = "Data.Stream"-#endif  ------------------------------------------------------------------------------- -- Main@@ -70,7 +66,7 @@ #ifndef USE_STREAMLY_CORE         , Exceptions.benchmarks moduleName env size #endif-#ifdef USE_PRELUDE+#ifndef USE_PRELUDE         , Split.benchmarks moduleName env #endif         , Transformation.benchmarks moduleName size
+ benchmark/Streamly/Benchmark/Data/Stream/Adaptive.hs view
@@ -0,0 +1,160 @@+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Control.Concurrent (threadDelay)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Data.Stream.Prelude (Stream, Config)+import System.Random (randomRIO)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream++import Test.Tasty.Bench++-- Note that we should also compare the cpuTime especially when threaded+-- runtime is used with this benchmark because thread scheduling is not+-- predictable and can add non-deterministic delay to the total time measured.+--+-- Also, the worker dispatch depends on the worker dispatch latency which is+-- set to fixed 200 us. We need to keep that in mind when designing tests.++moduleName :: String+moduleName = "Data.Stream.Adaptive"++value :: Int+value = 1000++produce :: MonadIO m => (Int, Int) -> m Int+produce range = do+    r <- randomRIO range+    when (r /= 0) $ liftIO $ threadDelay r+    return r++consume :: MonadIO m => (Int, Int) -> Int -> m Int+consume crange x = liftIO $ do+    d <- randomRIO crange+    when (d /= 0) $ threadDelay d+    return x++{-# INLINE serialSrc #-}+serialSrc :: (Int, Int) -> Stream IO Int+serialSrc range = Stream.replicateM value $ produce range++{-# INLINE parSrc #-}+parSrc :: (Config -> Config) -> (Int, Int) -> Stream IO Int+parSrc cfg range = Stream.parReplicateM cfg value $ produce range++{-# INLINE serialRun #-}+serialRun :: (Int, Int) -> (Int, Int) -> IO ()+serialRun srange crange =+    Stream.fold Fold.drain+        $ Stream.mapM (consume crange) (serialSrc srange)++{-# INLINE parRun #-}+parRun :: (Config -> Config) -> (Int, Int) -> (Int, Int) -> IO ()+parRun cfg srange crange =+    Stream.fold Fold.drain+        $ Stream.parMapM cfg (consume crange) (parSrc cfg srange)++low, medium, high :: Int+low = 10+medium = 20+high = 30++{-# INLINE noDelaySerial #-}+noDelaySerial :: IO ()+noDelaySerial = serialRun (0,0) (0,0)++{-# INLINE noDelay #-}+noDelay :: (Config -> Config) -> IO ()+noDelay cfg = parRun cfg (0,0) (0,0)++{-# INLINE alwaysConstSlowSerial #-}+alwaysConstSlowSerial :: IO ()+alwaysConstSlowSerial = serialRun (0,0) (medium,medium)++{-# INLINE alwaysConstSlow #-}+alwaysConstSlow :: (Config -> Config) -> IO ()+alwaysConstSlow cfg = parRun cfg (low,low) (medium,medium)++{-# INLINE alwaysConstFast #-}+alwaysConstFast :: (Config -> Config) -> IO ()+alwaysConstFast cfg = parRun cfg (high,high) (medium,medium)++{-# INLINE alwaysVarSlow #-}+alwaysVarSlow :: (Config -> Config) -> IO ()+alwaysVarSlow cfg = parRun cfg (low,low) (low,high)++{-# INLINE alwaysVarFast #-}+alwaysVarFast :: (Config -> Config) -> IO ()+alwaysVarFast cfg = parRun cfg (high,high) (low,high)++-- XXX add variable producer tests as well++{-# INLINE runVarSometimesFast #-}+runVarSometimesFast :: (Config -> Config) -> IO ()+runVarSometimesFast cfg = parRun cfg (medium,medium) (low,high)++{-# INLINE randomVar #-}+randomVar :: (Config -> Config) -> IO ()+randomVar cfg = parRun cfg (low,high) (low,high)++main :: IO ()+main =+  defaultMain [bgroup moduleName allBenchmarks]++  where++  allBenchmarks =+    [+      bgroup "serialConstantSlowConsumer"+      [ bench "serial" $ nfIO alwaysConstSlowSerial+      ]+    , bgroup "default"+      [ bench "serial"      $ nfIO noDelaySerial+      , bench "async"       $ nfIO $ noDelay id+      , bench "ordered"     $ nfIO $ noDelay (Stream.ordered True)+      , bench "interleaved" $ nfIO $ noDelay (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ noDelay (Stream.eager True)+      ]+    , bgroup "constantSlowConsumer"+      [ bench "async"       $ nfIO $ alwaysConstSlow id+      , bench "ordered"     $ nfIO $ alwaysConstSlow (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysConstSlow (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysConstSlow (Stream.eager True)+      ]+   ,  bgroup "constantFastConsumer"+      [ bench "async"       $ nfIO $ alwaysConstFast id+      , bench "ordered"     $ nfIO $ alwaysConstFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysConstFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysConstFast (Stream.eager True)+      ]+   ,  bgroup "variableSlowConsumer"+      [ bench "async"       $ nfIO $ alwaysVarSlow id+      , bench "ordered"     $ nfIO $ alwaysVarSlow (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysVarSlow (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysVarSlow (Stream.eager True)+      ]+   ,  bgroup "variableFastConsumer"+      [ bench "async"       $ nfIO $ alwaysVarFast id+      , bench "ordered"     $ nfIO $ alwaysVarFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ alwaysVarFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ alwaysVarFast (Stream.eager True)+      ]+   ,  bgroup "variableSometimesFastConsumer"+      [ bench "async"       $ nfIO $ runVarSometimesFast id+      , bench "ordered"     $ nfIO $ runVarSometimesFast (Stream.ordered True)+      , bench "interleaved" $ nfIO $ runVarSometimesFast (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ runVarSometimesFast (Stream.eager True)+      ]+   ,  bgroup "variableFullOverlap"+      [ bench "async"       $ nfIO $ randomVar id+      , bench "ordered"     $ nfIO $ randomVar (Stream.ordered True)+      , bench "interleaved" $ nfIO $ randomVar (Stream.interleaved True)+      , bench "parallel"    $ nfIO $ randomVar (Stream.eager True)+      ]+   ]
benchmark/Streamly/Benchmark/Data/Stream/Common.hs view
@@ -10,15 +10,11 @@ -- Maintainer  : streamly@composewell.com  #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  module Stream.Common     ( MonadAsync -    , fromStream-    , toStream-     -- Generation     , fromListM     , fromFoldableM@@ -40,14 +36,17 @@      -- Benchmark stream elimination     , benchIOSink+    , benchIOSinkPureSrc     , benchIOSrc     , benchIO +    , toNullApPure+    , toNullMPure+    , toNullM3Pure+    , filterAllOutMPure+    , filterAllInMPure+     -- Benchmarking functions-#ifdef USE_STREAMK-    , concatStreamsWith-    , mergeMapWith-#endif     , apDiscardFst     , apDiscardSnd     , apLiftA2@@ -67,7 +66,12 @@     , transformMapM     , transformComposeMapM     , transformTeeMapM-    , transformZipMapM+    -- , transformZipMapM+#ifndef USE_PRELUDE+    , scanMapM+    , scanComposeMapM+    , scanTeeMapM+#endif     ) where @@ -81,46 +85,25 @@  import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Pipe as Pipe+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanr as Scanr  #ifdef USE_PRELUDE import Streamly.Prelude (foldl', scanl') import qualified Streamly.Internal.Data.Stream.IsStream as Stream import qualified Streamly.Prelude as Stream-import qualified Streamly.Prelude as StreamK import Streamly.Benchmark.Prelude     ( composeN, sourceConcatMapId, benchIOSink-    , concatStreamsWith     ) #else import Streamly.Internal.Data.Stream (Stream) import qualified Streamly.Internal.Data.Stream as D-#ifdef USE_STREAMK-import Streamly.Internal.Data.StreamK (StreamK) import qualified Streamly.Internal.Data.Stream as Stream-import qualified Streamly.Internal.Data.StreamK as StreamK-#else-import qualified Streamly.Internal.Data.Stream as Stream-import qualified Streamly.Internal.Data.Stream as StreamK #endif-#endif  import Test.Tasty.Bench import Prelude hiding (Foldable(..), mapM, replicate) -#ifdef USE_STREAMK-toStream :: Applicative m => StreamK m a -> Stream m a-toStream = StreamK.toStream--fromStream :: Monad m => Stream m a -> StreamK m a-fromStream = StreamK.fromStream-#else-fromStream :: a -> a-fromStream = id--toStream :: a -> a-toStream = id-#endif- #ifdef USE_PRELUDE type Stream = Stream.SerialT type MonadAsync m = Stream.MonadAsync m@@ -129,19 +112,11 @@ #else type MonadAsync = Monad -#ifdef USE_STREAMK-mkCross :: StreamK m a -> StreamK.CrossStreamK m a-mkCross = StreamK.mkCross--unCross :: StreamK.CrossStreamK m a -> StreamK m a-unCross = StreamK.unCross-#else-mkCross :: Stream m a -> Stream.CrossStream m a-mkCross = Stream.mkCross+mkCross :: Stream m a -> Stream.Nested m a+mkCross = Stream.Nested -unCross :: Stream.CrossStream m a -> Stream m a-unCross = Stream.unCross-#endif+unCross :: Stream.Nested m a -> Stream m a+unCross = Stream.unNested #endif  #ifdef USE_PRELUDE@@ -149,14 +124,9 @@ append :: Monad m => Stream m a -> Stream m a -> Stream m a append = Stream.serial #else-#ifdef USE_STREAMK-append :: StreamK m a -> StreamK m a -> StreamK m a-append = StreamK.append-#else append :: Monad m => Stream m a -> Stream m a -> Stream m a append = Stream.append #endif-#endif  {-# INLINE append2 #-} append2 :: Monad m => Stream m a -> Stream m a -> Stream m a@@ -191,7 +161,7 @@ #ifdef USE_PRELUDE fromFoldableM = Stream.fromFoldableM #else-fromFoldableM = Stream.sequence . toStream . StreamK.fromFoldable+fromFoldableM = Stream.sequence . Stream.fromFoldable #endif  {-# INLINE sourceUnfoldrM #-}@@ -229,7 +199,7 @@  {-# INLINE sourceFromFoldable #-} sourceFromFoldable :: Monad m => Int -> Int -> Stream m Int-sourceFromFoldable value n = toStream $ StreamK.fromFoldable [n..n+value]+sourceFromFoldable value n = Stream.fromFoldable [n..n+value]  #ifndef USE_PRELUDE {-# INLINE benchIOSink #-}@@ -238,6 +208,13 @@     => Int -> String -> (Stream IO Int -> IO b) -> Benchmark benchIOSink value name f =     bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldrM value++{-# INLINE benchIOSinkPureSrc #-}+benchIOSinkPureSrc+    :: (NFData b)+    => Int -> String -> (Stream IO Int -> IO b) -> Benchmark+benchIOSinkPureSrc value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . sourceUnfoldr value #endif  -- | Takes a source, and uses it with a default drain/fold method.@@ -254,32 +231,6 @@ benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f  #ifndef USE_PRELUDE-#ifdef USE_STREAMK-{-# INLINE concatStreamsWith #-}-concatStreamsWith-    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)-    -> Int-    -> Int-    -> Int-    -> IO ()-concatStreamsWith op outer inner n =-    drain $ toStream $ StreamK.concatMapWith op-        (fromStream . sourceUnfoldrM inner)-        (fromStream $ sourceUnfoldrM outer n)--{-# INLINE mergeMapWith #-}-mergeMapWith-    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)-    -> Int-    -> Int-    -> Int-    -> IO ()-mergeMapWith op outer inner n =-    drain $ toStream $ StreamK.mergeMapWith op-        (fromStream . sourceUnfoldrM inner)-        (fromStream $ sourceUnfoldrM outer n)-#endif- {-# INLINE sourceConcatMapId #-} sourceConcatMapId :: (Monad m)     => Int -> Int -> Stream m (Stream m Int)@@ -290,9 +241,9 @@ {-# INLINE apDiscardFst #-} apDiscardFst :: MonadAsync m =>     Int -> Int -> m ()-apDiscardFst linearCount start = drain $ toStream $ unCross $-    mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-        *> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+apDiscardFst linearCount start = drain $ unCross $+    mkCross (sourceUnfoldrM nestedCount2 start)+        *> mkCross (sourceUnfoldrM nestedCount2 start)      where @@ -300,9 +251,9 @@  {-# INLINE apDiscardSnd #-} apDiscardSnd :: MonadAsync m => Int -> Int -> m ()-apDiscardSnd linearCount start = drain $ toStream $ unCross $-    mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-        <* mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+apDiscardSnd linearCount start = drain $ unCross $+    mkCross (sourceUnfoldrM nestedCount2 start)+        <* mkCross (sourceUnfoldrM nestedCount2 start)      where @@ -310,9 +261,9 @@  {-# INLINE apLiftA2 #-} apLiftA2 :: MonadAsync m => Int -> Int -> m ()-apLiftA2 linearCount start = drain $ toStream $ unCross $-    liftA2 (+) (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))-        (mkCross (fromStream $ sourceUnfoldrM nestedCount2 start))+apLiftA2 linearCount start = drain $ unCross $+    liftA2 (+) (mkCross (sourceUnfoldrM nestedCount2 start))+        (mkCross (sourceUnfoldrM nestedCount2 start))      where @@ -320,19 +271,29 @@  {-# INLINE toNullAp #-} toNullAp :: MonadAsync m => Int -> Int -> m ()-toNullAp linearCount start = drain $ toStream $ unCross $-    (+) <$> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-        <*> mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+toNullAp linearCount start = drain $ unCross $+    (+) <$> mkCross (sourceUnfoldrM nestedCount2 start)+        <*> mkCross (sourceUnfoldrM nestedCount2 start)      where      nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) +{-# INLINE toNullApPure #-}+toNullApPure :: MonadAsync m => Int -> Int -> m ()+toNullApPure linearCount start = drain $ unCross $+    (+) <$> mkCross (sourceUnfoldr nestedCount2 start)+        <*> mkCross (sourceUnfoldr nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))+ {-# INLINE monadThen #-} monadThen :: MonadAsync m => Int -> Int -> m ()-monadThen linearCount start = drain $ toStream $ unCross $ do-    mkCross (fromStream $ sourceUnfoldrM nestedCount2 start) >>-        mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+monadThen linearCount start = drain $ unCross $ do+    mkCross (sourceUnfoldrM nestedCount2 start) >>+        mkCross (sourceUnfoldrM nestedCount2 start)      where @@ -340,67 +301,112 @@  {-# INLINE toNullM #-} toNullM :: MonadAsync m => Int -> Int -> m ()-toNullM linearCount start = drain $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+toNullM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)     return $ x + y      where      nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) +{-# INLINE toNullMPure #-}+toNullMPure :: MonadAsync m => Int -> Int -> m ()+toNullMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))+ {-# INLINE toNullM3 #-} toNullM3 :: MonadAsync m => Int -> Int -> m ()-toNullM3 linearCount start = drain $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)-    z <- mkCross (fromStream $ sourceUnfoldrM nestedCount3 start)+toNullM3 linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount3 start)+    y <- mkCross (sourceUnfoldrM nestedCount3 start)+    z <- mkCross (sourceUnfoldrM nestedCount3 start)     return $ x + y + z   where     nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) +{-# INLINE toNullM3Pure #-}+toNullM3Pure :: MonadAsync m => Int -> Int -> m ()+toNullM3Pure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount3 start)+    y <- mkCross (sourceUnfoldr nestedCount3 start)+    z <- mkCross (sourceUnfoldr nestedCount3 start)+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))+ {-# INLINE filterAllOutM #-} filterAllOutM :: MonadAsync m => Int -> Int -> m ()-filterAllOutM linearCount start = drain $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+filterAllOutM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)     let s = x + y     if s < 0     then return s-    else mkCross StreamK.nil+    else mkCross Stream.nil   where     nestedCount2 = round (fromIntegral linearCount**(1/2::Double))  {-# INLINE filterAllInM #-} filterAllInM :: MonadAsync m => Int -> Int -> m ()-filterAllInM linearCount start = drain $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+filterAllInM linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)     let s = x + y     if s > 0     then return s-    else mkCross StreamK.nil+    else mkCross Stream.nil   where     nestedCount2 = round (fromIntegral linearCount**(1/2::Double)) +{-# INLINE filterAllOutMPure #-}+filterAllOutMPure :: MonadAsync m => Int -> Int -> m ()+filterAllOutMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    let s = x + y+    if s < 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInMPure #-}+filterAllInMPure :: MonadAsync m => Int -> Int -> m ()+filterAllInMPure linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldr nestedCount2 start)+    y <- mkCross (sourceUnfoldr nestedCount2 start)+    let s = x + y+    if s > 0+    then return s+    else mkCross Stream.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))+ {-# INLINE filterSome #-} filterSome :: MonadAsync m => Int -> Int -> m ()-filterSome linearCount start = drain $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+filterSome linearCount start = drain $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)     let s = x + y     if s > 1100000     then return s-    else mkCross StreamK.nil+    else mkCross Stream.nil   where     nestedCount2 = round (fromIntegral linearCount**(1/2::Double))  {-# INLINE breakAfterSome #-} breakAfterSome :: Int -> Int -> IO () breakAfterSome linearCount start = do-    (_ :: Either ErrorCall ()) <- try $ drain $ toStream $ unCross $ do-        x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-        y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+    (_ :: Either ErrorCall ()) <- try $ drain $ unCross $ do+        x <- mkCross (sourceUnfoldrM nestedCount2 start)+        y <- mkCross (sourceUnfoldrM nestedCount2 start)         let s = x + y         if s > 1100000         then error "break"@@ -411,9 +417,9 @@  {-# INLINE toListM #-} toListM :: MonadAsync m => Int -> Int -> m [Int]-toListM linearCount start = toList $ toStream $ unCross $ do-    x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-    y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+toListM linearCount start = toList $ unCross $ do+    x <- mkCross (sourceUnfoldrM nestedCount2 start)+    y <- mkCross (sourceUnfoldrM nestedCount2 start)     return $ x + y   where     nestedCount2 = round (fromIntegral linearCount**(1/2::Double))@@ -423,9 +429,9 @@ {-# INLINE toListSome #-} toListSome :: MonadAsync m => Int -> Int -> m [Int] toListSome linearCount start =-    toList $ Stream.take 10000 $ toStream $ unCross $ do-        x <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)-        y <- mkCross (fromStream $ sourceUnfoldrM nestedCount2 start)+    toList $ Stream.take 10000 $ unCross $ do+        x <- mkCross (sourceUnfoldrM nestedCount2 start)+        y <- mkCross (sourceUnfoldrM nestedCount2 start)         return $ x + y   where     nestedCount2 = round (fromIntegral linearCount**(1/2::Double))@@ -468,7 +474,7 @@ foldl' f z = Stream.fold (Fold.foldl' f z)  scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-scanl' f z = Stream.scan (Fold.foldl' f z)+scanl' f z = Stream.scanl (Scanl.mkScanl f z) #endif  {-# INLINE transformMapM #-}@@ -477,8 +483,22 @@     => Int     -> Stream m Int     -> m ()+#ifndef USE_PRELUDE+transformMapM n = composeN n $ Stream.pipe (Pipe.mapM return)+#else transformMapM n = composeN n $ Stream.transform (Pipe.mapM return)+#endif +#ifndef USE_PRELUDE+{-# INLINE scanMapM #-}+scanMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanMapM n = composeN n $ Stream.scanr (Scanr.functionM return)+#endif+ {-# INLINE transformComposeMapM #-} transformComposeMapM ::        (Monad m)@@ -487,10 +507,28 @@     -> m () transformComposeMapM n =     composeN n $+#ifndef USE_PRELUDE+    Stream.pipe+#else     Stream.transform+#endif         (Pipe.mapM (\x -> return (x + 1)) `Pipe.compose`          Pipe.mapM (\x -> return (x + 2))) +#ifndef USE_PRELUDE+{-# INLINE scanComposeMapM #-}+scanComposeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanComposeMapM n =+    composeN n $+    Stream.scanr+        (Scanr.functionM (\x -> return (x + 1)) `Scanr.compose`+         Scanr.functionM (\x -> return (x + 2)))+#endif+ {-# INLINE transformTeeMapM #-} transformTeeMapM ::        (Monad m)@@ -499,10 +537,29 @@     -> m () transformTeeMapM n =     composeN n $+#ifndef USE_PRELUDE+    Stream.pipe+#else     Stream.transform-        (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`+#endif+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge`          Pipe.mapM (\x -> return (x + 2))) +#ifndef USE_PRELUDE+{-# INLINE scanTeeMapM #-}+scanTeeMapM ::+       (Monad m)+    => Int+    -> Stream m Int+    -> m ()+scanTeeMapM n =+    composeN n $+    Stream.scanr+        (Scanr.teeWith (+) (Scanr.functionM (\x -> return (x + 1)))+         (Scanr.functionM (\x -> return (x + 2))))+#endif++{- {-# INLINE transformZipMapM #-} transformZipMapM ::        (Monad m)@@ -511,8 +568,9 @@     -> m () transformZipMapM n =     composeN n $-    Stream.transform+    Stream.pipe         (Pipe.zipWith              (+)              (Pipe.mapM (\x -> return (x + 1)))              (Pipe.mapM (\x -> return (x + 2))))+-}
benchmark/Streamly/Benchmark/Data/Stream/ConcurrentCommon.hs view
@@ -56,7 +56,7 @@ o_n_heap_buffering value f =     [ bgroup "buffered"         [ benchIOSink value "mkAsync"-            (Stream.fold Fold.drain . Async.parEval f)+            (Stream.fold Fold.drain . Async.parBuffered f)         ]     ] @@ -147,10 +147,10 @@         $ Async.parConcat f         $ fmap (sourceUnfoldrM inner) (sourceUnfoldrM outer n) -o_1_space_concatMap :: Int -> (Config -> Config) -> [Benchmark]-o_1_space_concatMap value f =+o_1_space_concatMap :: String -> Int -> (Config -> Config) -> [Benchmark]+o_1_space_concatMap label value f =     value2 `seq`-        [ bgroup "concat"+        [ bgroup ("concat" ++ label)             [ benchIO "parConcatMap (n of 1)"                   (concatMapStreamsWith f value 1)             , benchIO "parConcatMap (sqrt x of sqrt x)"@@ -174,7 +174,7 @@ toNullAp :: (Config -> Config) -> Int -> Int -> IO () toNullAp f linearCount start =     Stream.fold Fold.drain-        $ Async.parApply f+        $ Async.parCrossApply f             (fmap (+) (sourceUnfoldrM nestedCount2 start))             (sourceUnfoldrM nestedCount2 start) @@ -198,7 +198,9 @@     [ bgroup (o_1_space_prefix moduleName) $ concat         [ o_1_space_mapping value modifier         , o_1_space_concatFoldable value modifier-        , o_1_space_concatMap value modifier+        , o_1_space_concatMap "" value modifier+        , o_1_space_concatMap "-maxThreads-1" value (modifier . Async.maxThreads 1)+        , o_1_space_concatMap "-rate-Nothing" value (modifier . Async.rate Nothing)         , o_1_space_joining value modifier         ] ++ if wide then [] else o_1_space_outerProduct value modifier     , bgroup (o_n_heap_prefix moduleName) $ concat
+ benchmark/Streamly/Benchmark/Data/Stream/ConcurrentThreadHeavy.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-}+-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Control.Concurrent+import Control.Monad (when, replicateM)+import Streamly.Data.Stream.Prelude (Config)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream++import Test.Tasty (localOption)+import Test.Tasty.Bench++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++-- | Run @tcount@ number of actions concurrently using the given concurrency+-- style. Each thread produces a single output after a delay of @d@+-- microseconds.+--+{-# INLINE append #-}+append :: Int -> Int -> Int -> (Config -> Config) -> IO ()+append buflen tcount d modifier =+    let work i = when (d /= 0) (threadDelay d) >> return i+        cfg =+              modifier+            . Stream.maxBuffer buflen+            . Stream.maxThreads (-1)+    in Stream.fold Fold.drain+        $ Stream.parMapM cfg work+        $ Stream.fromList [1..tcount]++-- | Run @threads@ concurrently, each producing streams of @elems@ elements+-- with a delay of @d@ microseconds between successive elements, and merge+-- their outputs in a single output stream. The individual streams are produced+-- serially but merged using the provided concurrency style.+--+{-# INLINE concated #-}+concated+    :: Int+    -> Int+    -> Int+    -> Int+    -> (Config -> Config)+    -> IO ()+concated buflen threads d elems modifier =+    let work i =+            Stream.replicateM i (when (d /= 0) (threadDelay d) >> return i)+        cfg =+              modifier+            . Stream.maxBuffer buflen+            . Stream.maxThreads (-1)+    in Stream.fold Fold.drain+        $ Stream.parConcatMap cfg work+        $ Stream.replicate threads elems++appendGroup :: Int -> Int -> Int -> [Benchmark]+appendGroup buflen threads usec =+    [ -- bench "serial"   $ nfIO $ append buflen threads delay fromSerial+      bench "async"+        $ nfIO $ append buflen threads usec id+    , bench "ordered"+        $ nfIO $ append buflen threads usec (Stream.ordered True)+    , bench "interleaved"+        $ nfIO $ append buflen threads usec (Stream.interleaved True)+    , bench "parallel"+        $ nfIO $ append buflen threads usec (Stream.eager True)+    ]++concatGroup :: Int -> Int -> Int -> Int -> [Benchmark]+concatGroup buflen threads usec n =+    [ -- bench "serial"   $ nfIO $ concated buflen threads usec n serial+      bench "async"+        $ nfIO $ concated buflen threads usec n id+    , bench "ordered"+        $ nfIO $ concated buflen threads usec n (Stream.ordered True)+    , bench "interleaved"+        $ nfIO $ concated buflen threads usec n (Stream.interleaved True)+    , bench "parallel"+        $ nfIO $ concated buflen threads usec n (Stream.eager True)+    ]++main :: IO ()+main =+    defaultMain $ map (localOption (RelStDev 100000))+    [ -- bgroup "append/buf-1-threads-10k-0sec"  (appendGroup 1 10000 0)+    -- , bgroup "append/buf-100-threads-100k-0sec"  (appendGroup 100 100000 0)+      bgroup "streamly/threads10k-delay5s-singleton(buf10k)"  (appendGroup 10000 10000 5000000)+    --  bgroup "concat/buf-1-threads-100k-count-1" (concatGroup 1 100000 0 1)+    --  bgroup "concat/buf-1-threads-1-count-10m" (concatGroup 1 1 0 10000000)+    , bgroup "streamly/threads100-delay0s-stream500k(buf100)"  (concatGroup 100 100 0 500000)++    , bench "forkIO/threads10k-delay5s-singleton" $+        let delay = threadDelay 5000000+            count = 10000 :: Int+            list = [1..count]+            work i = delay >> return i+        in nfIO $ do+            ref <- newEmptyMVar+            mapM_ (\i -> forkIO (work i >>= \j -> putMVar ref j)) list+            replicateM 10000 (takeMVar ref)+   ]
benchmark/Streamly/Benchmark/Data/Stream/Eliminate.hs view
@@ -12,7 +12,6 @@  {-# OPTIONS_GHC -Wno-orphans #-} #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  #ifdef __HADDOCK_VERSION__@@ -26,6 +25,7 @@  module Stream.Eliminate (benchmarks) where +import Control.Monad (when) import Control.DeepSeq (NFData(..)) import Data.Functor.Identity (Identity, runIdentity) import System.Random (randomRIO)@@ -44,18 +44,11 @@ import Streamly.Prelude (fromSerial) import Streamly.Benchmark.Prelude import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.IsStream as StreamK #else import Stream.Common import Streamly.Internal.Data.Stream (Stream) import qualified Streamly.Internal.Data.Stream as S-#ifdef USE_STREAMK-import Streamly.Internal.Data.StreamK (StreamK)-import qualified Streamly.Data.StreamK as StreamK-#else-import qualified Streamly.Internal.Data.Stream as StreamK #endif-#endif  import Test.Tasty.Bench import Streamly.Benchmark.Common@@ -277,27 +270,35 @@ -------------------------------------------------------------------------------  {-# INLINE uncons #-}-#ifdef USE_STREAMK-uncons :: Monad m => StreamK m Int -> m ()-#else uncons :: Monad m => Stream m Int -> m ()-#endif uncons s = do-    r <- StreamK.uncons s+    r <- S.uncons s     case r of         Nothing -> return ()         Just (_, t) -> uncons t +#ifndef USE_PRELUDE+{-# INLINE toNull #-}+toNull :: Monad m => Stream m Int -> m ()+toNull = S.drain+#endif+ #ifdef USE_PRELUDE {-# INLINE init #-} init :: Monad m => Stream m a -> m () init s = S.init s >>= Prelude.mapM_ S.drain+#endif  {-# INLINE mapM_ #-} mapM_ :: Monad m => Stream m Int -> m () mapM_ = S.mapM_ (\_ -> return ())-#endif +{-# INLINE foldBreak #-}+foldBreak :: Monad m => Stream m Int -> m ()+foldBreak s = do+    (r, s1) <- S.foldBreak (Fold.take 1 Fold.length) s+    when (r /= 0) $ foldBreak s1+ {-# INLINE foldrMElem #-} foldrMElem :: Monad m => Int -> Stream m Int -> m Bool foldrMElem e =@@ -308,25 +309,23 @@                  else xs)         (return False) -#ifdef USE_STREAMK-{-# INLINE foldrToStream #-}-foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int)-foldrToStream = S.foldr StreamK.cons StreamK.nil-#else -- {-# INLINE foldrToStream #-} -- foldrToStream :: Monad m => Stream m Int -> m (Stream Identity Int) -- foldrToStream = S.foldr S.cons S.nil-#endif  {-# INLINE foldrMBuild #-} foldrMBuild :: Monad m => Stream m Int -> m [Int] foldrMBuild = S.foldrM (\x xs -> (x :) <$> xs) (return []) -#ifdef USE_PRELUDE {-# INLINE foldl'Reduce #-} foldl'Reduce :: Monad m => Stream m Int -> m Int foldl'Reduce = S.foldl' (+) 0 +{-# INLINE last #-}+last :: Monad m => Stream m Int -> m (Maybe Int)+last = S.last++#ifdef USE_PRELUDE {-# INLINE foldl1'Reduce #-} foldl1'Reduce :: Monad m => Stream m Int -> m (Maybe Int) foldl1'Reduce = S.foldl1' (+)@@ -335,10 +334,6 @@ foldlM'Reduce :: Monad m => Stream m Int -> m Int foldlM'Reduce = S.foldlM' (\xs a -> return $ a + xs) (return 0) -{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last = S.last- {-# INLINE _head #-} _head :: Monad m => Stream m Int -> m (Maybe Int) _head = S.head@@ -460,19 +455,10 @@                   ]             , bgroup "Identity"                   [ benchIdentitySink value "foldrMElem" (foldrMElem value)-#ifdef USE_STREAMK-                  , benchIdentitySink value "foldrToStreamLength"-                        (S.fold Fold.length . toStream . runIdentity . foldrToStream)                   {-                   , benchIdentitySink 16 "foldrToStreamLength (16)"-                        (S.fold Fold.length . toStream . runIdentity . foldrToStream)-                  -}-#else-                  {--                  , benchIdentitySink 16 "foldrToStreamLength (16)"                         (S.fold Fold.length . runIdentity . foldrToStream)                   -}-#endif                   {-                   , benchPureSink 16 "foldrMToListLength (16)"                         (Prelude.length . runIdentity . foldrMBuild)@@ -483,10 +469,15 @@             ]          -- deconstruction-        , benchIOSink value "uncons" (uncons . fromStream)+        , benchIOSink value "uncons" uncons+        , benchIOSink value "mapM_" mapM_+        , benchIOSink value "last" last #ifndef USE_PRELUDE         , benchHoistSink value "length . generalizeInner"               (S.fold Fold.length . S.generalizeInner)+        , benchIOSink value "toNull" toNull+        , benchIOSink value "foldBreak" foldBreak+        , benchIOSink value "foldl" foldl'Reduce #endif #ifdef USE_PRELUDE         , benchIOSink value "init" init@@ -496,11 +487,9 @@         , benchIOSink value "drainN" $ drainN value         , benchIOSink value "drainWhile" drainWhile         , benchPureSink value "drain (pure)" id-        , benchIOSink value "mapM_" mapM_          -- this is too fast, causes all benchmarks reported in ns     -- , benchIOSink value "head" head-        , benchIOSink value "last" last         , benchIOSink value "length" length         , benchIOSink value "sum" sum         , benchIOSink value "product" product@@ -589,6 +578,10 @@         -- expression needs to be fully built before it can be reduced.         , benchIdentitySink value "foldrM/reduce/Identity (sum)" foldrMReduce         , benchIOSink value "foldrM/reduce/IO (sum)" foldrMReduce++        -- This is horribly slow, never finishes+        -- let foldlS = composeN n $ S.foldlS (flip S.cons) S.nil+        --  in benchFold "foldlS"  (foldlS    1) sourceUnfoldrM         ]     ]
benchmark/Streamly/Benchmark/Data/Stream/Exceptions.hs view
@@ -11,7 +11,6 @@ {-# LANGUAGE ScopedTypeVariables #-}  #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  #ifdef __HADDOCK_VERSION__@@ -179,7 +178,11 @@ readWriteHandleExceptionStream :: Handle -> Handle -> IO () readWriteHandleExceptionStream inh devNull =     let handler (_e :: SomeException) =+#ifndef USE_PRELUDE             return $ Stream.fromEffect (hClose inh >> return 10)+#else+            Stream.fromEffect (hClose inh >> return 10)+#endif         readEx = Stream.handle handler (Stream.unfold FH.reader inh)     in Stream.fold (FH.write devNull) readEx
benchmark/Streamly/Benchmark/Data/Stream/Expand.hs view
@@ -8,10 +8,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-}-{-# LANGUAGE TupleSections #-}  #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  #ifdef __HADDOCK_VERSION__@@ -37,22 +35,18 @@  #ifdef USE_PRELUDE import qualified Streamly.Internal.Data.Stream.IsStream as S-import qualified Streamly.Internal.Data.Stream.IsStream as StreamK import Streamly.Benchmark.Prelude     ( sourceFoldMapM, sourceFoldMapWith, sourceFoldMapWithM     , sourceFoldMapWithStream, concatFoldableWith, concatForFoldableWith) #else+import Streamly.Data.Stream (Stream)+import Streamly.Data.Unfold (Unfold) import qualified Streamly.Internal.Data.Stream as S-#ifdef USE_STREAMK-import Streamly.Internal.Data.Stream (Stream)-import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)-import qualified Control.Applicative as AP+import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.StreamK as StreamK-#else-import qualified Streamly.Internal.Data.Stream as StreamK #endif-#endif  import Test.Tasty.Bench import Stream.Common@@ -60,49 +54,6 @@ import Prelude hiding (concatMap)  ---------------------------------------------------------------------------------- Iteration/looping utilities----------------------------------------------------------------------------------#ifdef USE_STREAMK-{-# INLINE iterateN #-}-iterateN :: (Int -> a -> a) -> a -> Int -> a-iterateN g initial count = f count initial--    where--    f (0 :: Int) x = x-    f i x = f (i - 1) (g i x)---- Iterate a transformation over a singleton stream-{-# INLINE iterateSingleton #-}-iterateSingleton :: Applicative m =>-       (Int -> CrossStreamK m Int -> CrossStreamK m Int)-    -> Int-    -> Int-    -> Stream m Int-iterateSingleton g count n =-    toStream-        $ StreamK.unCross-        $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count-#endif--{---- XXX need to check why this is slower than the explicit recursion above, even--- if the above code is written in a foldr like head recursive way. We also--- need to try this with foldlM' once #150 is fixed.--- However, it is perhaps best to keep the iteration benchmarks independent of--- foldrM and any related fusion issues.-{-# INLINE _iterateSingleton #-}-_iterateSingleton ::-       Monad m-    => (Int -> Stream m Int -> Stream m Int)-    -> Int-    -> Int-    -> Stream m Int-_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n--}--------------------------------------------------------------------------------- -- Multi-Stream ------------------------------------------------------------------------------- @@ -113,22 +64,22 @@ {-# INLINE serial2 #-} serial2 :: Int -> Int -> IO () serial2 count n =-    drain $ toStream $+    drain $         Common.append-            (fromStream $ sourceUnfoldrM count n)-            (fromStream $ sourceUnfoldrM count (n + 1))+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1))  {-# INLINE serial4 #-} serial4 :: Int -> Int -> IO () serial4 count n =-    drain $ toStream $+    drain $     Common.append         (Common.append-            (fromStream $ sourceUnfoldrM count n)-            (fromStream $ sourceUnfoldrM count (n + 1)))+            (sourceUnfoldrM count n)+            (sourceUnfoldrM count (n + 1)))         (Common.append-              (fromStream $ sourceUnfoldrM count (n + 2))-              (fromStream $ sourceUnfoldrM count (n + 3)))+              (sourceUnfoldrM count (n + 2))+              (sourceUnfoldrM count (n + 3)))  o_1_space_joining :: Int -> [Benchmark] o_1_space_joining value =@@ -170,11 +121,21 @@ {-# INLINE concatMap #-} concatMap :: Int -> Int -> Int -> IO () concatMap outer inner n =-    drain $ toStream $ StreamK.concatMap-        (\_ -> fromStream $ sourceUnfoldrM inner n)-        (fromStream $ sourceUnfoldrM outer n)+    drain $ S.concatMap+        (\_ -> sourceUnfoldrM inner n)+        (sourceUnfoldrM outer n) -#ifndef USE_STREAMK+{-# INLINE concatMapViaUnfoldEach #-}+concatMapViaUnfoldEach :: Int -> Int -> Int -> IO ()+concatMapViaUnfoldEach outer inner n =+    drain $ cmap+        (\_ -> sourceUnfoldrM inner n)+        (sourceUnfoldrM outer n)++    where++    cmap f = Stream.unfoldEach (UF.lmap f UF.fromStream)+ {-# INLINE concatMapM #-} concatMapM :: Int -> Int -> Int -> IO () concatMapM outer inner n =@@ -186,16 +147,15 @@ inspect $ hasNoTypeClasses 'concatMap inspect $ 'concatMap `hasNoType` ''SPEC #endif-#endif  -- concatMap unfoldr/unfoldr  {-# INLINE concatMapPure #-} concatMapPure :: Int -> Int -> Int -> IO () concatMapPure outer inner n =-    drain $ toStream $ StreamK.concatMap-        (\_ -> fromStream $ sourceUnfoldr inner n)-        (fromStream $ sourceUnfoldr outer n)+    drain $ S.concatMap+        (\_ -> sourceUnfoldr inner n)+        (sourceUnfoldr outer n)  #ifdef INSPECTION #if __GLASGOW_HASKELL__ >= 906@@ -206,201 +166,150 @@ inspect $ 'concatMapPure `hasNoType` ''SPEC #endif --- concatMap replicate/unfoldrM--{-# INLINE concatMapRepl #-}-concatMapRepl :: Int -> Int -> Int -> IO ()-concatMapRepl outer inner n =-    drain $ toStream $ StreamK.concatMap-        (fromStream . S.replicate inner) (fromStream $ sourceUnfoldrM outer n)--#ifdef INSPECTION-#if __GLASGOW_HASKELL__ >= 906-inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]-#else-inspect $ hasNoTypeClasses 'concatMapRepl-#endif-inspect $ 'concatMapRepl `hasNoType` ''SPEC-#endif---- concatMapWith+{-# INLINE sourceUnfoldrMUnfold #-}+sourceUnfoldrMUnfold :: Monad m => Int -> Int -> Unfold m Int Int+sourceUnfoldrMUnfold size start = UF.unfoldrM step -#ifdef USE_STREAMK-{-# INLINE concatMapWithSerial #-}-concatMapWithSerial :: Int -> Int -> Int -> IO ()-concatMapWithSerial = concatStreamsWith Common.append+    where -#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapWithSerial-inspect $ 'concatMapWithSerial `hasNoType` ''SPEC-#endif+    step i =+        return+            $ if i < start + size+              then Just (i, i + 1)+              else Nothing -{--{-# INLINE concatMapWithAppend #-}-concatMapWithAppend :: Int -> Int -> Int -> IO ()-concatMapWithAppend = concatStreamsWith Common.append2+{-# INLINE unfoldEach #-}+unfoldEach :: Int -> Int -> Int -> IO ()+unfoldEach outer inner start = drain $+     -- XXX the replicateM takes much more time compared to unfoldrM, is there+     -- a perf issue or this is just because of accessing outer loop variables?+     -- S.unfoldEach (UF.lmap ((inner,) . return) UF.replicateM)+     S.unfoldEach (sourceUnfoldrMUnfold inner start)+        $ sourceUnfoldrM outer start  #ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapWithAppend-inspect $ 'concatMapWithAppend `hasNoType` ''SPEC-#endif--}---- mergeMapWith--{-# INLINE mergeMapWithSerial #-}-mergeMapWithSerial :: Int -> Int -> Int -> IO ()-mergeMapWithSerial = mergeMapWith Common.append--{--{-# INLINE mergeMapWithAppend #-}-mergeMapWithAppend :: Int -> Int -> Int -> IO ()-mergeMapWithAppend = mergeMapWith Common.append2--}+inspect $ hasNoTypeClasses 'unfoldEach+inspect $ 'unfoldEach `hasNoType` ''D.ConcatMapUState+inspect $ 'unfoldEach `hasNoType` ''SPEC #endif --- unfoldMany---- unfoldMany replicate/unfoldrM+{-# INLINE unfoldEach2 #-}+unfoldEach2 :: Int -> Int -> Int -> IO ()+unfoldEach2 outer inner start = drain $+     S.unfoldEach (UF.carry (sourceUnfoldrMUnfold inner start))+        $ sourceUnfoldrM outer start -{-# INLINE unfoldManyRepl #-}-unfoldManyRepl :: Int -> Int -> Int -> IO ()-unfoldManyRepl outer inner n =-    drain-         $ S.unfoldMany-               UF.replicateM-               (fmap ((inner,) . return) (sourceUnfoldrM outer n))+{-# INLINE unfoldEach3 #-}+unfoldEach3 :: Int -> Int -> IO ()+unfoldEach3 linearCount start = drain $ do+    S.unfoldEach (UF.carry (UF.lmap snd (sourceUnfoldrMUnfold nestedCount3 start)))+         $ S.unfoldEach (UF.carry (sourceUnfoldrMUnfold nestedCount3 start))+            $ sourceUnfoldrM nestedCount3 start+    where +    nestedCount3 = round (fromIntegral linearCount**(1/3::Double)) -#ifdef INSPECTION-inspect $ hasNoTypeClasses 'unfoldManyRepl-inspect $ 'unfoldManyRepl `hasNoType` ''D.ConcatMapUState-inspect $ 'unfoldManyRepl `hasNoType` ''SPEC-#endif+{-# INLINE unfoldCross #-}+unfoldCross :: Int -> Int -> Int -> IO ()+unfoldCross outer inner start = drain $+    Stream.unfoldCross+        UF.identity+        (sourceUnfoldrM outer start)+        (sourceUnfoldrM inner start)  o_1_space_concat :: Int -> [Benchmark] o_1_space_concat value = sqrtVal `seq`     [ bgroup "concat"-        [ benchIOSrc1 "concatMapPure (n of 1)"+        [ benchIOSrc1 "concatMapPure outer=Max inner=1"             (concatMapPure value 1)-        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"+        , benchIOSrc1 "concatMapPure outer=inner=(sqrt Max)"             (concatMapPure sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapPure (1 of n)"+        , benchIOSrc1 "concatMapPure outer=1 inner=Max"             (concatMapPure 1 value) -        , benchIOSrc1 "concatMap (n of 1)"+        , benchIOSrc1 "concatMap outer=max inner=1"             (concatMap value 1)-        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"+        , benchIOSrc1 "concatMap outer=inner=(sqrt Max)"             (concatMap sqrtVal sqrtVal)-        , benchIOSrc1 "concatMap (1 of n)"+        , benchIOSrc1 "concatMap outer=1 inner=Max"             (concatMap 1 value) -#ifndef USE_STREAMK         -- This is for comparison with foldMapWith-        , benchIOSrc "concatMapId (n of 1) (fromFoldable)"+        , benchIOSrc "concatMapId outer=max inner=1 (fromFoldable)"             (S.concatMap id . sourceConcatMapId value) -        , benchIOSrc1 "concatMapM (n of 1)"+        , benchIOSrc1 "concatMapM outer=max inner=1"             (concatMapM value 1)-        , benchIOSrc1 "concatMapM (sqrt n of sqrt n)"+        , benchIOSrc1 "concatMapM outer=inner=(sqrt Max)"             (concatMapM sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapM (1 of n)"+        , benchIOSrc1 "concatMapM outer=1 inner=Max"             (concatMapM 1 value)-#endif -#ifdef USE_STREAMK-        {--        -- This is for comparison with foldMapWith-        , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"-            (toStream . S.concatMapWith Common.append id . sourceConcatMapId value)-        -}--        , benchIOSrc1 "concatMapWith (n of 1)"-            (concatMapWithSerial value 1)-        , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"-            (concatMapWithSerial sqrtVal sqrtVal)-        , benchIOSrc1 "concatMapWith (1 of n)"-            (concatMapWithSerial 1 value)--        {--        -- quadratic with number of outer streams-        , benchIOSrc1 "concatMapWithAppend (2 of n/2)"-            (concatMapWithAppend 2 (value `div` 2))-        -}-#endif--        -- concatMap vs unfoldMany-        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"-            (concatMapRepl sqrtVal sqrtVal)-        , benchIOSrc1 "unfoldManyRepl (sqrt n of sqrt n)"-            (unfoldManyRepl sqrtVal sqrtVal)-        ]-    ]--    where--    sqrtVal = round $ sqrt (fromIntegral value :: Double)+        , benchIOSrc1 "concatMapViaUnfoldEach outer=max inner=1"+            (concatMapViaUnfoldEach value 1)+        , benchIOSrc1 "concatMapViaUnfoldEach outer=inner=(sqrt Max)"+            (concatMapViaUnfoldEach sqrtVal sqrtVal)+        , benchIOSrc1 "concatMapViaUnfoldEach outer=1 inner=Max"+            (concatMapViaUnfoldEach 1 value) -#ifdef USE_STREAMK-o_n_space_merge :: Int -> [Benchmark]-o_n_space_merge value = sqrtVal `seq`-    [ bgroup "concat"-        [-        -------------------mergeMapWith-----------------+        , benchIOSrc1 "unfoldCross outer=max inner=1"+            (unfoldCross value 1)+        , benchIOSrc1 "unfoldCross outer=inner=(sqrt Max)"+            (unfoldCross sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldCross outer=1 inner=Max"+            (unfoldCross 1 value) -        -- Use large number of streams to check scalability+        -- concatMap vs unfoldEach+        , benchIOSrc1 "unfoldEach outer=Max inner=1"+            (unfoldEach value 1)+        , benchIOSrc1 "unfoldEach outer=inner=(sqrt Max)"+            (unfoldEach sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldEach outer=1 inner=Max"+            (unfoldEach 1 value) -          benchIOSrc1 "mergeMapWithSerial (n of 1)"-            (mergeMapWithSerial value 1)-        , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"-            (mergeMapWithSerial sqrtVal sqrtVal)-        , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"-            (mergeMapWithSerial 2 (value `div` 2))+        , benchIOSrc1 "unfoldEach2 outer=Max inner=1"+            (unfoldEach2 value 1)+        , benchIOSrc1 "unfoldEach2 outer=inner=(sqrt Max)"+            (unfoldEach2 sqrtVal sqrtVal)+        , benchIOSrc1 "unfoldEach2 outer=1 inner=Max"+            (unfoldEach2 1 value) -        {--        , benchIOSrc1 "mergeMapWithAppend (n of 1)"-            (mergeMapWithAppend value 1)-        , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"-            (mergeMapWithAppend sqrtVal sqrtVal)-        -}+        , benchIOSrc1 "unfoldEach3 outer=inner=(cubert Max)"+            (unfoldEach3 value)         ]     ]      where      sqrtVal = round $ sqrt (fromIntegral value :: Double)-#endif  ------------------------------------------------------------------------------- -- Applicative ------------------------------------------------------------------------------- +{-# INLINE cross2 #-}+cross2 :: MonadAsync m => Int -> Int -> m ()+cross2 linearCount start = drain $+    Stream.crossWith (+)+        (sourceUnfoldr nestedCount2 start)+        (sourceUnfoldr nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))+ o_1_space_applicative :: Int -> [Benchmark] o_1_space_applicative value =     [ bgroup "Applicative"-        [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value-        , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value-        , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value-        , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value+        [ benchIO "(*>)" $ apDiscardFst value+        , benchIO "(<*)" $ apDiscardSnd value+        , benchIO "(<*>)" $ toNullAp value+        , benchIO "liftA2" $ apLiftA2 value+        , benchIO "pureDrain2" $ toNullApPure value+        , benchIO "pureCross2" $ cross2 value         ]     ] -#ifdef USE_STREAMK-o_n_space_applicative :: Int -> [Benchmark]-o_n_space_applicative value =-    [ bgroup "iterated"-        [ benchIOSrc "(*>) (n times)" $-            iterateSingleton ((*>) . pure) value-        , benchIOSrc "(<*) (n times)" $-            iterateSingleton (\x xs -> xs <* pure x) value-        , benchIOSrc "(<*>) (n times)" $-            iterateSingleton (\x xs -> pure (+ x) <*> xs) value-        , benchIOSrc "liftA2 (n times)" $-            iterateSingleton (AP.liftA2 (+) . pure) value-        ]-    ]-#endif- ------------------------------------------------------------------------------- -- Monad -------------------------------------------------------------------------------@@ -408,61 +317,323 @@ o_1_space_monad :: Int -> [Benchmark] o_1_space_monad value =     [ bgroup "Monad"-        [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value-        , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value-        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $-            filterAllOutM value-        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $-            filterAllInM value-        , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $-            filterSome value-        , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $-            breakAfterSome value-        , benchIO "(>>=) (cubert n x cubert n x cubert n)" $-            toNullM3 value+        [ benchIO "then2" $ monadThen value+        , benchIO "drain2" $ toNullM value+        , benchIO "drain3" $ toNullM3 value+        , benchIO "filterAllOut2" $ filterAllOutM value+        , benchIO "filterAllIn2" $ filterAllInM value+        , benchIO "filterSome2" $ filterSome value+        , benchIO "breakAfterSome2" $ breakAfterSome value+        , benchIO "pureDrain2" $ toNullMPure value+        , benchIO "pureDrain3" $ toNullM3Pure value+        , benchIO "pureFilterAllIn2" $ filterAllInMPure value+        , benchIO "pureFilterAllOut2" $ filterAllOutMPure value         ]     ] -#ifdef USE_STREAMK--- This is a good benchmark but inefficient way to compute primes. As we see a--- new prime we keep appending a division filter for all the future numbers.-{-# INLINE sieve #-}-sieve :: Monad m => StreamK m Int -> StreamK m Int-sieve s = StreamK.concatEffect $ do-    r <- StreamK.uncons s-    case r of-        Just (prime, rest) ->-            -- XXX Use K.filter or rewrite to K.filter-            let f = S.filter (\n -> n `mod` prime /= 0)-             in pure $ prime `StreamK.cons` sieve (fromStream $ f $ toStream rest)-        Nothing -> pure StreamK.nil+o_n_space_monad :: Int -> [Benchmark]+o_n_space_monad value =+    [ bgroup "Monad"+        [ benchIO "toList2" $ toListM value+        , benchIO "toListSome2" $ toListSome value+        ]+    ] -o_n_space_iterated :: Int -> [Benchmark]-o_n_space_iterated value =-    [ bgroup "iterated"-        [-          benchIO "concatEffect prime sieve (n/4)"-            (\n ->-                  S.fold Fold.sum-                $ toStream-                $ sieve-                $ fromStream-                $ S.enumerateFromTo 2 (value `div` 4 + n))-        , benchIOSrc "(>>) (n times)" $-            iterateSingleton ((>>) . pure) value-        , benchIOSrc "(>>=) (n times)" $-            iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value+{-# INLINE drainConcatFor1 #-}+drainConcatFor1 :: Monad m => Stream m Int -> m ()+drainConcatFor1 s = drain $ do+    Stream.concatFor s $ \x ->+            Stream.fromPure $ x + 1++{-# INLINE drainConcatFor #-}+drainConcatFor :: Monad m => Stream m Int -> m ()+drainConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.fromPure $ x + y++{-# INLINE drainConcatForM #-}+drainConcatForM :: Monad m => Stream m Int -> m ()+drainConcatForM s = drain $ do+    Stream.concatForM s $ \x ->+        pure $ Stream.concatForM s $ \y ->+            pure $ Stream.fromPure $ x + y++{-# INLINE drainConcatFor3 #-}+drainConcatFor3 :: Monad m => Stream m Int -> m ()+drainConcatFor3 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.fromPure $ x + y + z++{-# INLINE drainConcatFor4 #-}+drainConcatFor4 :: Monad m => Stream m Int -> m ()+drainConcatFor4 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.concatFor s $ \w ->+                    Stream.fromPure $ x + y + z + w++{-# INLINE drainConcatFor5 #-}+drainConcatFor5 :: Monad m => Stream m Int -> m ()+drainConcatFor5 s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            Stream.concatFor s $ \z ->+                Stream.concatFor s $ \w ->+                    Stream.concatFor s $ \u ->+                        Stream.fromPure $ x + y + z + w + u++{-# INLINE drainConcatFor3M #-}+drainConcatFor3M :: Monad m => Stream m Int -> m ()+drainConcatFor3M s = drain $ do+    Stream.concatForM s $ \x ->+        pure $ Stream.concatForM s $ \y ->+            pure $ Stream.concatForM s $ \z ->+                pure $ Stream.fromPure $ x + y + z++{-# INLINE filterAllInConcatFor #-}+filterAllInConcatFor+    :: Monad m+    => Stream m Int -> m ()+filterAllInConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            let s1 = x + y+             in if s1 > 0+                then Stream.fromPure s1+                else Stream.nil++{-# INLINE filterAllOutConcatFor #-}+filterAllOutConcatFor+    :: Monad m+    => Stream m Int -> m ()+filterAllOutConcatFor s = drain $ do+    Stream.concatFor s $ \x ->+        Stream.concatFor s $ \y ->+            let s1 = x + y+             in if s1 < 0+                then Stream.fromPure s1+                else Stream.nil++o_1_space_bind :: Int -> [Benchmark]+o_1_space_bind streamLen =+    [ bgroup "concatFor"+        [ benchFold "drain1" drainConcatFor1   (sourceUnfoldrM streamLen)+        , benchFold "drain2" drainConcatFor   (sourceUnfoldrM streamLen2)+        , benchFold "drain3" drainConcatFor3   (sourceUnfoldrM streamLen3)+        , benchFold "drain4" drainConcatFor4   (sourceUnfoldrM streamLen4)+        , benchFold "drain5" drainConcatFor5   (sourceUnfoldrM streamLen5)+        , benchFold "drainM2" drainConcatForM   (sourceUnfoldrM streamLen2)+        , benchFold "drainM3" drainConcatFor3M   (sourceUnfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInConcatFor  (sourceUnfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutConcatFor (sourceUnfoldrM streamLen2)         ]     ]-#endif -o_n_space_monad :: Int -> [Benchmark]-o_n_space_monad value =-    [ bgroup "Monad"-        [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $-            toListM value-        , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $-            toListSome value+    where++    streamLen2 = round (fromIntegral streamLen**(1/2::Double)) -- double nested loop+    streamLen3 = round (fromIntegral streamLen**(1/3::Double)) -- triple nested loop+    streamLen4 = round (fromIntegral streamLen**(1/4::Double)) -- 4 times nested loop+    streamLen5 = round (fromIntegral streamLen**(1/5::Double)) -- 5 times nested loop++-- search space |x| = 1000, |y| = 1000+{-# INLINE boundedInts #-}+boundedInts :: Monad m => Int -> Int -> Stream m Int+boundedInts n _ =+    Stream.interleave+        (Stream.enumerateFromTo (0 :: Int) n)+        (Stream.enumerateFromThenTo (-1) (-2) (-n))++{-# INLINE infiniteInts #-}+infiniteInts :: Monad m => Int -> Int -> Stream m Int+infiniteInts _ _ =+    Stream.interleave+        (Stream.enumerateFrom (0 :: Int))+        (Stream.enumerateFromThen (-1) (-2))++{-# INLINE boundedIntsUnfold #-}+boundedIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int+boundedIntsUnfold n _ =+    Unfold.interleave+        (Unfold.supply (0 :: Int, n) Unfold.enumerateFromTo)+        (Unfold.supply (-1, -2, -n) Unfold.enumerateFromThenTo)++{-# INLINE infiniteIntsUnfold #-}+infiniteIntsUnfold :: Monad m => Int -> Int -> Unfold m ((), ()) Int+infiniteIntsUnfold _ _ =+    Unfold.interleave+        (Unfold.supply (0 :: Int) Unfold.enumerateFrom)+        (Unfold.supply (-1, -2) Unfold.enumerateFromThen)++{-# INLINE checkStream #-}+checkStream :: Applicative m =>+    Int -> Int -> Stream m (Maybe (Maybe (Int, Int)))+checkStream x y =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then Stream.fromPure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then Stream.fromPure (Just Nothing)+        else Stream.fromPure Nothing++{-# INLINE checkStreamK #-}+checkStreamK :: Int -> Int -> StreamK.StreamK m (Maybe (Maybe (Int, Int)))+checkStreamK x y =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then StreamK.fromPure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then StreamK.fromPure (Just Nothing)+        else StreamK.fromPure Nothing++{-# INLINE checkPair #-}+checkPair :: Monad m => (Int, Int) -> m (Maybe (Maybe (Int, Int)))+checkPair (x, y) =+    let eq1 = x + y == 0+        eq2 = x - y == 1994+     in if eq1 && eq2+        then pure (Just (Just (x,y)))+        else if abs x > 1000 && abs y > 1000+        then pure (Just Nothing)+        else pure Nothing++result :: Monad m => Stream m (Maybe a) -> m ()+result = Stream.fold (Fold.take 1 Fold.drain) . Stream.catMaybes++fairConcatForEqn :: Monad m => Stream m Int -> m ()+fairConcatForEqn input =+    result+        $ Stream.fairConcatFor input $ \x ->+              Stream.fairConcatForM input $ \y -> do+                return $ checkStream x y++fairConcatForEqnK :: Monad m => Stream m Int -> m ()+fairConcatForEqnK input =+    let inputK = StreamK.fromStream input+    in result+        $ StreamK.toStream+        $ StreamK.fairConcatFor inputK $ \x ->+              StreamK.fairConcatForM inputK $ \y -> do+                return $ checkStreamK x y++concatForEqn :: Monad m => Stream m Int -> m ()+concatForEqn input =+    result+        $ Stream.concatFor input $ \x ->+              Stream.concatForM input $ \y -> do+                return $ checkStream x y++fairSchedForEqn :: Monad m => Stream m Int -> m ()+fairSchedForEqn input =+    result+        $ Stream.fairSchedFor input $ \x ->+              Stream.fairSchedForM input $ \y -> do+                return $ checkStream x y++_schedForEqn :: Monad m => Stream m Int -> m ()+_schedForEqn input =+    result+        $ Stream.schedFor input $ \x ->+              Stream.schedForM input $ \y -> do+                return $ checkStream x y++streamCrossEqn :: Monad m => Stream m Int -> m ()+streamCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.cross input input++fairStreamCrossEqn :: Monad m => Stream m Int -> m ()+fairStreamCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.fairCross input input++unfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()+unfoldCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.unfold (Unfold.cross input input) (undefined, undefined)++fairUnfoldCrossEqn :: Monad m => Unfold m ((), ()) Int -> m ()+fairUnfoldCrossEqn input =+    result+        $ Stream.mapM checkPair+        $ Stream.unfold (Unfold.fairCross input input) (undefined, undefined)++unfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+unfoldEachEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.unfoldEach intu ints++fairUnfoldEachEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+fairUnfoldEachEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.fairUnfoldEach intu ints++unfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+unfoldSchedEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.unfoldSched intu ints++fairUnfoldSchedEqn :: Monad m => Unfold m ((), ()) Int -> Stream m Int -> m ()+fairUnfoldSchedEqn input ints =+    let intu = Unfold.carry $ Unfold.lmap (const (undefined, undefined)) input+     in result+        $ Stream.mapM checkPair+        $ Stream.fairUnfoldSched intu ints++-- Solve simultaneous equations by exploring all possibilities+o_1_space_equations :: Int -> [Benchmark]+o_1_space_equations _ =+    [ bgroup "equations"+        [ benchFold "concatFor (bounded)" concatForEqn (boundedInts 1000)+        , benchFold "fairConcatFor (bounded)"+            fairConcatForEqn (boundedInts 1000)+        , benchFold "fairConcatForK (bounded)"+            fairConcatForEqnK (boundedInts 1000)+        , benchFold "fairConcatFor (infinite)"+            fairConcatForEqn (infiniteInts 1000)+        , benchFold "fairSchedFor (bounded)"+            fairSchedForEqn (boundedInts 1000)+        , benchFold "fairSchedFor (infinite)"+            fairSchedForEqn (infiniteInts 1000)+        , benchFold "streamCross (bounded)"+            streamCrossEqn (boundedInts 1000)+        , benchFold "fairStreamCross (bounded)"+            fairStreamCrossEqn (boundedInts 1000)+        , benchFold "fairStreamCross (infinite)"+            fairStreamCrossEqn (infiniteInts 1000)+        , bench "unfoldCross (bounded)"+            $ nfIO $ unfoldCrossEqn (boundedIntsUnfold 1000 0)+        , bench "fairUnfoldCross (bounded)"+            $ nfIO $ fairUnfoldCrossEqn (boundedIntsUnfold 1000 0)+        , bench "fairUnfoldCross (infinite)"+            $ nfIO $ fairUnfoldCrossEqn (infiniteIntsUnfold 1000 0)+        , benchFold "unfoldEach (bounded)"+            (unfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldEach (bounded)"+            (fairUnfoldEachEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldEach (infinite)"+            (fairUnfoldEachEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)+        , benchFold "unfoldSched (bounded)"+            (unfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldSched (bounded)"+            (fairUnfoldSchedEqn (boundedIntsUnfold 1000 0)) (boundedInts 1000)+        , benchFold "fairUnfoldSched (infinite)"+            (fairUnfoldSchedEqn (infiniteIntsUnfold 1000 0)) (infiniteInts 1000)         ]     ] @@ -515,6 +686,9 @@             $ joinWith S.filterInStreamGenericBy sqrtVal         , benchIOSrc1 "filterInStreamAscBy"             $ joinMapWith (S.filterInStreamAscBy compare) halfVal+        -- Note: schedFor does a bfs scheduling, therefore, can take a lot of+        -- memory.+        , benchFold "schedFor (bounded)" schedForEqn (boundedInts 1000)         ]     ] @@ -544,16 +718,13 @@             , o_1_space_concat size             , o_1_space_applicative size             , o_1_space_monad size+            , o_1_space_bind size+            , o_1_space_equations size             ]         , bgroup (o_n_space_prefix moduleName) $ Prelude.concat             [             -- multi-stream               o_n_space_monad size-#ifdef USE_STREAMK-            , o_n_space_merge size-            , o_n_space_iterated size-            , o_n_space_applicative size-#endif             ]        {-        , bgroup (o_n_heap_prefix moduleName) $
benchmark/Streamly/Benchmark/Data/Stream/Generate.hs view
@@ -12,7 +12,6 @@  {-# OPTIONS_GHC -Wno-orphans #-} #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  module Stream.Generate (benchmarks) where@@ -33,12 +32,7 @@ import Stream.Common import Streamly.Internal.Data.Stream (Stream) import qualified Streamly.Internal.Data.Stream as Stream-#ifdef USE_STREAMK-import System.IO.Unsafe (unsafeInterleaveIO)-import qualified Streamly.Internal.Data.StreamK as StreamK-import qualified Stream.Common as Common #endif-#endif  import Test.Tasty.Bench import Streamly.Benchmark.Common@@ -182,18 +176,6 @@ fromIndicesM value n = S.take value $ S.fromIndicesM (return <$> (+ n)) #endif -#ifdef USE_STREAMK-{-# INLINE mfixUnfold #-}-mfixUnfold :: Int -> Int -> Stream IO (Int, Int)-mfixUnfold count start = toStream $ StreamK.mfix f-    where-    f action = StreamK.unCross $ do-        let incr n act = fmap ((+n) . snd)  $ unsafeInterleaveIO act-        x <- StreamK.mkCross (fromStream $ Common.fromListM [incr 1 action, incr 2 action])-        y <- StreamK.mkCross (fromStream $ Common.sourceUnfoldr count start)-        return (x, y)-#endif- o_1_space_generation :: Int -> [Benchmark] o_1_space_generation value =     [ bgroup "generation"@@ -225,22 +207,12 @@         , benchIOSrc "fromIndicesM" (fromIndicesM value) #endif -          -- These essentially test cons and consM-#ifdef USE_STREAMK-        , benchIOSrc "fromFoldable" (sourceFromFoldable value)-        -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)-#else+        -- These essentially test cons and consM         -- , benchIOSrc "fromFoldable 16" (sourceFromFoldable 16)-#endif  #ifdef USE_PRELUDE         , benchIOSrc "fromFoldableM" (sourceFromFoldableM value)         , benchIOSrc "absTimes" $ absTimes value-#endif-#ifdef USE_STREAMK-        , Common.benchIOSrc "mfix_10" (mfixUnfold 10)-        , Common.benchIOSrc "mfix_100" (mfixUnfold 100)-        , Common.benchIOSrc "mfix_1000" (mfixUnfold 1000) #endif         ]     ]
benchmark/Streamly/Benchmark/Data/Stream/Lift.hs view
@@ -10,7 +10,6 @@ {-# LANGUAGE RankNTypes #-}  #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  module Stream.Lift (benchmarks) where@@ -29,13 +28,7 @@ #else import Streamly.Internal.Data.Stream (Stream) import qualified Streamly.Internal.Data.Stream as Stream-#ifdef USE_STREAMK-import Stream.Common (benchIO, drain)-import Streamly.Internal.Data.StreamK (StreamK)-import qualified Streamly.Internal.Data.StreamK as StreamK-import qualified Control.Monad.State.Strict as State #endif-#endif  import Test.Tasty.Bench import Streamly.Benchmark.Common@@ -93,43 +86,6 @@         ]     ] -#ifdef USE_STREAMK-{-# INLINE iterateStateIO #-}-iterateStateIO ::-       Monad m-    => Int-    -> StateT Int m Int-iterateStateIO n = do-    x <- get-    if x > n-    then do-        put (x - 1)-        iterateStateIO n-    else return x---- XXX This is basically testing the perf of concatEffect, change it to just--- use concatEffect and move it along with other concatMap benchmarks.-{-# INLINE iterateStateT #-}-iterateStateT :: Int -> StreamK (StateT Int IO) Int-iterateStateT n = StreamK.concatEffect $ do-    x <- get-    if x > n-    then do-        put (x - 1)-        return $ iterateStateT n-    else return $ StreamK.fromPure x--o_n_heap_transformer :: Int -> [Benchmark]-o_n_heap_transformer value =-    [ bgroup "transformer"-        [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->-            State.evalStateT (iterateStateIO n) value-        , benchIO "Stream (StateT Int IO) (n times)" $ \n ->-            State.evalStateT (drain $ Common.toStream (iterateStateT n)) value-        ]-    ]-#endif- ------------------------------------------------------------------------------- -- Main -------------------------------------------------------------------------------@@ -140,7 +96,4 @@ benchmarks :: String -> Int -> [Benchmark] benchmarks moduleName size =         [ bgroup (o_1_space_prefix moduleName) (o_1_space_hoisting size)-#ifdef USE_STREAMK-        , bgroup (o_n_heap_prefix moduleName) (o_n_heap_transformer size)-#endif         ]
+ benchmark/Streamly/Benchmark/Data/Stream/Rate.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE FlexibleContexts #-}++-- |+-- Module      : Main+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++import Stream.Common (benchIOSrc, sourceUnfoldrM)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Prelude (MonadAsync, Config)++import qualified Streamly.Data.Stream.Prelude as Stream++import Streamly.Benchmark.Common+import Test.Tasty.Bench++moduleName :: String+moduleName = "Data.Stream.Rate"++-------------------------------------------------------------------------------+-- Average Rate+-------------------------------------------------------------------------------++{-# INLINE rateNothing #-}+rateNothing :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Int -> Stream m Int+rateNothing f cfg value = f (Stream.rate Nothing . cfg) . sourceUnfoldrM value++{-# INLINE avgRate #-}+avgRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+avgRate f cfg value rt = f (Stream.avgRate rt . cfg) . sourceUnfoldrM value++{-+-- parBuffered should be maxThreads 1 anyway+{-# INLINE avgRateThreads1 #-}+avgRateThreads1 :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+avgRateThreads1 f cfg value rt =+    f (Stream.maxThreads 1 . Stream.avgRate rt . cfg) . sourceUnfoldrM value+-}++{-# INLINE minRate #-}+minRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+minRate f cfg value rt = f (Stream.minRate rt . cfg) . sourceUnfoldrM value++{-# INLINE maxRate #-}+maxRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+maxRate f cfg value rt = f (Stream.minRate rt . cfg) . sourceUnfoldrM value++{-# INLINE constRate #-}+constRate :: MonadAsync m =>+    ((Config -> Config) -> Stream m Int -> Stream m Int)+    -> (Config -> Config) -> Int -> Double -> Int -> Stream m Int+constRate f cfg value rt = f (Stream.constRate rt . cfg) . sourceUnfoldrM value++-- XXX arbitrarily large rate should be the same as rate Nothing+-- XXX Add tests for multiworker cases as well - parMapM+o_1_space_async :: Int -> [Benchmark]+o_1_space_async value =+    [ bgroup+          "default/parBuffered"+          [ bgroup+                "avgRate"+                -- benchIO "unfoldr" $ toNull+                [ benchIOSrc "baseline" (Stream.parBuffered id . sourceUnfoldrM value)+                , benchIOSrc "Nothing" $ rateNothing Stream.parBuffered id value+                , benchIOSrc "1M" $ avgRate Stream.parBuffered id value 1000000+                , benchIOSrc "3M" $ avgRate Stream.parBuffered id value 3000000+                -- , benchIOSrc "10M/maxThreads1" $ avgRateThreads1 Stream.parBuffered value 10000000+                , benchIOSrc "10M" $ avgRate Stream.parBuffered id value 10000000+                , benchIOSrc "20M" $ avgRate Stream.parBuffered id value 20000000+                ]+          , bgroup+                "minRate"+                [ benchIOSrc "1M" $ minRate Stream.parBuffered id value 1000000+                , benchIOSrc "10M" $ minRate Stream.parBuffered id value 10000000+                , benchIOSrc "20M" $ minRate Stream.parBuffered id value 20000000+                ]+          , bgroup+                "maxRate"+                [ -- benchIOSrc "10K" $ maxRate value 10000+                  benchIOSrc "10M" $ maxRate Stream.parBuffered id value 10000000+                ]+          , bgroup+                "constRate"+                [ -- benchIOSrc "10K" $ constRate value 10000+                  benchIOSrc "1M" $ constRate Stream.parBuffered id value 1000000+                , benchIOSrc "10M" $ constRate Stream.parBuffered id value 10000000+                ]+          ]+    ]++o_1_space_ahead :: Int -> [Benchmark]+o_1_space_ahead value =+    [ bgroup+        "ordered/parBuffered"+        [ benchIOSrc "avgRate/1M"+            $ avgRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "minRate/1M"+            $ minRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "maxRate/1M"+            $ maxRate Stream.parBuffered (Stream.ordered True) value 1000000+        , benchIOSrc "constRate/1M"+            $ constRate Stream.parBuffered (Stream.ordered True) value 1000000+        ]+    ]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks value =+        [ bgroup (o_1_space_prefix moduleName)+        $ concat [o_1_space_async value, o_1_space_ahead value]]
benchmark/Streamly/Benchmark/Data/Stream/Reduce.hs view
@@ -12,13 +12,14 @@ {-# LANGUAGE RankNTypes #-}  #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  module Stream.Reduce (benchmarks) where  import Control.DeepSeq (NFData(..))+import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..))+import Data.Maybe (isJust) import Data.Monoid (Sum(..)) import GHC.Generics (Generic) @@ -33,7 +34,6 @@ #endif  #ifdef USE_PRELUDE-import Control.Monad (when) import qualified Streamly.Internal.Data.Stream.IsStream as S import qualified Streamly.Prelude as S import Streamly.Prelude (fromSerial)@@ -50,17 +50,8 @@ import qualified Streamly.Data.Stream.Prelude as S import qualified Streamly.Internal.Data.Stream.Prelude as S #endif--#ifdef USE_STREAMK-import Streamly.Internal.Data.StreamK (StreamK)-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.StreamK as K-#else-import qualified Streamly.Internal.Data.Stream as K #endif -#endif- import Test.Tasty.Bench import Streamly.Benchmark.Common import Stream.Common@@ -71,25 +62,9 @@ #endif  -- Apply transformation g count times on a stream of length len-#ifdef USE_STREAMK {-# INLINE iterateSource #-} iterateSource ::        MonadAsync m-    => (StreamK m Int -> StreamK m Int)-    -> Int-    -> Int-    -> Int-    -> StreamK m Int-iterateSource g count len n = f count (fromStream $ sourceUnfoldrM len n)--    where--    f (0 :: Int) stream = stream-    f i stream = f (i - 1) (g stream)-#else-{-# INLINE iterateSource #-}-iterateSource ::-       MonadAsync m     => (Stream m Int -> Stream m Int)     -> Int     -> Int@@ -101,7 +76,6 @@      f (0 :: Int) stream = stream     f i stream = f (i - 1) (g stream)-#endif  ------------------------------------------------------------------------------- -- Grouping transformations@@ -161,13 +135,15 @@     . S.foldMany (FL.take 2 FL.mconcat)     . fmap Sum -{-# INLINE foldManyPost #-}-foldManyPost :: Monad m => Stream m Int -> m ()-foldManyPost =+#ifndef USE_PRELUDE+{-# INLINE foldMany1 #-}+foldMany1 :: Monad m => Stream m Int -> m ()+foldMany1 =       Common.drain     . fmap getSum     . S.foldManyPost (FL.take 2 FL.mconcat)     . fmap Sum+#endif  {-# INLINE refoldMany #-} refoldMany :: Monad m => Stream m Int -> m ()@@ -195,16 +171,6 @@             (Refold.take 2 Refold.sconcat) (return (Sum 0))         . fmap Sum -#ifdef USE_STREAMK-{-# INLINE parseBreak #-}-parseBreak :: Monad m => StreamK m Int -> m ()-parseBreak s = do-    r <- K.parseDBreak PR.one s-    case r of-         (Left _, _) -> return ()-         (Right _, s1) -> parseBreak s1-#endif- o_1_space_grouping :: Int -> [Benchmark] o_1_space_grouping value =     -- Buffering operations using heap proportional to group/window sizes.@@ -221,13 +187,12 @@         -- modules we can bring those here. chunksOf benchmarks are in         -- Parser/ParserD/Array.Stream/FileSystem.Handle.           benchIOSink value "foldMany" foldMany-        , benchIOSink value "foldManyPost" foldManyPost+#ifndef USE_PRELUDE+        , benchIOSink value "foldMany1" foldMany1+#endif         , benchIOSink value "refoldMany" refoldMany         , benchIOSink value "foldIterateM" foldIterateM         , benchIOSink value "refoldIterateM" refoldIterateM-#ifdef USE_STREAMK-        , benchIOSink value "parseBreak (recursive)" (parseBreak . fromStream)-#endif  #ifndef USE_STREAMLY_CORE         , benchIOSink value "classifySessionsOf (10000 buckets)"@@ -256,7 +221,7 @@ #ifndef USE_PRELUDE {-# INLINE reverse #-} reverse :: MonadIO m => Int -> Stream m Int -> m ()-reverse n = composeN n (toStream . K.reverse . fromStream)+reverse n = composeN n S.reverse  {-# INLINE reverse' #-} reverse' :: MonadIO m => Int -> Stream m Int -> m ()@@ -383,12 +348,40 @@     -- need monolithic implementations of these.     [ bgroup "mixed"         [ benchIOSink value "scanl-map" (scanMap 1)+        , benchIOSink value "drop-map" (dropMap 1)+        , benchIOSink value "drop-scan" (dropScan 1)+        , benchIOSink value "take-drop" (takeDrop value 1)+        , benchIOSink value "take-scan" (takeScan value 1)+        , benchIOSink value "take-map" (takeMap value 1)+        , benchIOSink value "filter-drop" (filterDrop value 1)+        , benchIOSink value "filter-take" (filterTake value 1)+        , benchIOSink value "filter-scan" (filterScan 1)+        , benchIOSink value "filter-map" (filterMap value 1)         , benchIOSink value "foldl-map" foldl'ReduceMap         , benchIOSink value "sum-product-fold" sumProductFold         , benchIOSink value "sum-product-scan" sumProductScan         ]     ] +o_1_space_transformations_mixedX2 :: Int -> [Benchmark]+o_1_space_transformations_mixedX2 value =+    [ bgroup "mixedX2"+        [ benchIOSink value "scan-map" (scanMap 2)+        , benchIOSink value "drop-map" (dropMap 2)+        , benchIOSink value "drop-scan" (dropScan 2)+        , benchIOSink value "take-drop" (takeDrop value 2)+        , benchIOSink value "take-scan" (takeScan value 2)+        , benchIOSink value "take-map" (takeMap value 2)+        , benchIOSink value "filter-drop" (filterDrop value 2)+        , benchIOSink value "filter-take" (filterTake value 2)+        , benchIOSink value "filter-scan" (filterScan 2)+#ifdef USE_PRELUDE+        , benchIOSink value "filter-scanl1" (filterScanl1 2)+#endif+        , benchIOSink value "filter-map" (filterMap value 2)+        ]+    ]+ o_1_space_transformations_mixedX4 :: Int -> [Benchmark] o_1_space_transformations_mixedX4 value =     [ bgroup "mixedX4"@@ -412,49 +405,9 @@ -- Iterating a transformation over and over again ------------------------------------------------------------------------------- -#ifdef USE_STREAMK-{- -- this is quadratic {-# INLINE iterateScan #-} iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateScan count len = toStream . iterateSource (K.scanl' (+) 0) count len--}--{-# INLINE iterateMapM #-}-iterateMapM :: MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateMapM count len = toStream . iterateSource (K.mapM return) count len--{-# INLINE iterateFilterEven #-}-iterateFilterEven :: MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateFilterEven count len =-    toStream . iterateSource (K.filter even) count len--{-# INLINE iterateTakeAll #-}-iterateTakeAll :: MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int-iterateTakeAll value count len =-    toStream . iterateSource (K.take (value + 1)) count len--{-# INLINE iterateDropOne #-}-iterateDropOne :: MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateDropOne count len = toStream . iterateSource (K.drop 1) count len--{-# INLINE iterateDropWhileTrue #-}-iterateDropWhileTrue :: MonadAsync m-    => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileTrue value count len =-    toStream . iterateSource (K.dropWhile (<= (value + 1))) count len--{-# INLINE iterateDropWhileFalse #-}-iterateDropWhileFalse :: MonadAsync m-    => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileFalse value count len =-    toStream . iterateSource (K.dropWhile (> (value + 1))) count len--#else---- this is quadratic-{-# INLINE iterateScan #-}-iterateScan :: MonadAsync m => Int -> Int -> Int -> Stream m Int iterateScan = iterateSource (Common.scanl' (+) 0)  #ifdef USE_PRELUDE@@ -484,9 +437,12 @@ iterateDropWhileTrue :: MonadAsync m     => Int -> Int -> Int -> Int -> Stream m Int iterateDropWhileTrue value = iterateSource (S.dropWhile (<= (value + 1)))-#endif -#ifdef USE_PRELUDE+{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: MonadAsync m+    => Int -> Int -> Int -> Int -> Stream m Int+iterateDropWhileFalse value = iterateSource (S.dropWhile (> (value + 1)))+ {-# INLINE tail #-} tail :: Monad m => Stream m a -> m () tail s = S.tail s >>= mapM_ tail@@ -498,17 +454,24 @@     when (not r) $ do         _ <- S.head s         S.tail s >>= mapM_ nullHeadTail-#endif +nullTail :: Monad m => Stream m Int -> m ()+nullTail s = do+    r <- S.null s+    when (not r) $ S.tail s >>= mapM_ nullTail++headTail :: Monad m => Stream m Int -> m ()+headTail s = do+    h <- S.head s+    when (isJust h) $ S.tail s >>= mapM_ headTail+ -- Head recursive operations. o_n_stack_iterated :: Int -> [Benchmark] o_n_stack_iterated value = by10 `seq` by100 `seq`     [ bgroup "iterated"         [ benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10-#ifndef USE_STREAMK         , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $             iterateScan by100 100-#endif #ifdef USE_PRELUDE         , benchIOSrc "scanl1' (n/10 x 10)" $ iterateScanl1 by10 10 #endif@@ -517,17 +480,15 @@         , benchIOSrc "takeAll (n/10 x 10)" $             iterateTakeAll value by10 10         , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10-#ifdef USE_STREAMK-        , benchIOSrc "dropWhileFalse (n/10 x 10)" $-            iterateDropWhileFalse value by10 10-#endif         , benchIOSrc "dropWhileTrue (n/10 x 10)" $             iterateDropWhileTrue value by10 10-#ifdef USE_PRELUDE+        , benchIOSrc "dropWhileFalse (n/10 x 10)" $+            iterateDropWhileFalse value by10 10         , benchIOSink value "tail" tail+        , benchIOSink value "nullTail" nullTail+        , benchIOSink value "headTail" headTail         , benchIOSink value "nullHeadTail" nullHeadTail-#endif-        ]+     ]     ]      where@@ -547,7 +508,7 @@         , benchIOSink value "tee" (transformTeeMapM 1) #ifdef DEVBUILD         -- XXX this take 1 GB memory to compile-        , benchIOSink value "zip" (transformZipMapM 1)+        -- , benchIOSink value "zip" (transformZipMapM 1) #endif         ]     ]@@ -560,12 +521,37 @@         , benchIOSink value "tee" (transformTeeMapM 4) #ifdef DEVBUILD         -- XXX this take 1 GB memory to compile-        , benchIOSink value "zip" (transformZipMapM 4)+        -- , benchIOSink value "zip" (transformZipMapM 4) #endif         ]     ]  -------------------------------------------------------------------------------+-- Scans+-------------------------------------------------------------------------------++#ifndef USE_PRELUDE+o_1_space_scans :: Int -> [Benchmark]+o_1_space_scans value =+    [ bgroup "scans"+        [+          benchIOSink value "mapM" (scanMapM 1)+        , benchIOSink value "compose" (scanComposeMapM 1)+        , benchIOSink value "tee" (scanTeeMapM 1)+        ]+    ]++o_1_space_scansX4 :: Int -> [Benchmark]+o_1_space_scansX4 value =+    [ bgroup "scansX4"+        [ benchIOSink value "mapM" (scanMapM 4)+        , benchIOSink value "compose" (scanComposeMapM 4)+        , benchIOSink value "tee" (scanTeeMapM 4)+        ]+    ]+#endif++------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -577,11 +563,18 @@         [ bgroup (o_1_space_prefix moduleName) $ Prelude.concat             [ o_1_space_grouping size             , o_1_space_transformations_mixed size+            , o_1_space_transformations_mixedX2 size             , o_1_space_transformations_mixedX4 size              -- pipes             , o_1_space_pipes size             , o_1_space_pipesX4 size++#ifndef USE_PRELUDE+            -- scans+            , o_1_space_scans size+            , o_1_space_scansX4 size+#endif             ]         , bgroup (o_n_stack_prefix moduleName) (o_n_stack_iterated size)         , bgroup (o_n_heap_prefix moduleName) (o_n_heap_buffering size)
benchmark/Streamly/Benchmark/Data/Stream/Split.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Stream.Split@@ -25,15 +24,13 @@ import Data.Char (ord) import Data.Word (Word8) import System.IO (Handle)+import Streamly.Internal.Data.Array (Array) -import qualified Streamly.FileSystem.Handle as FH-import qualified Streamly.Internal.Data.Array as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Stream.IsStream as IP-import qualified Streamly.Internal.FileSystem.Handle as IFH-import qualified Streamly.Internal.Unicode.Stream as IUS-import qualified Streamly.Prelude as S+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode  import Test.Tasty.Bench hiding (env) import Prelude hiding (last, length)@@ -43,8 +40,8 @@ #ifdef INSPECTION import Streamly.Internal.Data.Stream (Step(..)) -import qualified Streamly.Internal.Data.MutArray as MA-import qualified Streamly.Internal.Data.Unfold as IUF+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Unfold as Unfold  import Test.Inspection #endif@@ -56,102 +53,106 @@ lf :: Word8 lf = fromIntegral (ord '\n') -toarr :: String -> A.Array Word8-toarr = A.fromList . map (fromIntegral . ord)+toarr :: String -> Array Word8+toarr = Array.fromList . map (fromIntegral . ord)  -- | Split on line feed. splitOn :: Handle -> IO Int splitOn inh =-    (S.length $ S.splitOn (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print+    (Stream.fold Fold.length+        $ Stream.splitSepBy_ (== lf) Fold.drain+        $ Handle.read inh) -- >>= print  #ifdef INSPECTION inspect $ hasNoTypeClasses 'splitOn inspect $ 'splitOn `hasNoType` ''Step-inspect $ 'splitOn `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitOn `hasNoType` ''MA.ArrayUnsafe  -- FH.read/A.read-#endif---- | Split suffix on line feed.-splitOnSuffix :: Handle -> IO Int-splitOnSuffix inh =-    (S.length $ S.splitOnSuffix (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'splitOnSuffix-inspect $ 'splitOnSuffix `hasNoType` ''Step-inspect $ 'splitOnSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitOnSuffix `hasNoType` ''MA.ArrayUnsafe  -- FH.read/A.read-#endif---- | Split suffix with line feed.-splitWithSuffix :: Handle -> IO Int-splitWithSuffix inh =-    (S.length $ S.splitWithSuffix (== lf) FL.drain-        $ S.unfold FH.read inh) -- >>= print--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'splitWithSuffix-inspect $ 'splitWithSuffix `hasNoType` ''Step-inspect $ 'splitWithSuffix `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'splitWithSuffix `hasNoType` ''MA.ArrayUnsafe  -- FH.read/A.read+inspect $ 'splitOn `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'splitOn `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif --- | Split on line feed.-foldManySepBy :: Handle -> IO Int-foldManySepBy inh =-    (S.length-        $ IP.foldMany-            (FL.takeEndBy_ (== lf) FL.drain)-            (S.unfold FH.read inh)-    ) -- >>= print---- | Split on line feed.-parseManySepBy :: Handle -> IO Int-parseManySepBy inh =-    (S.length-        $ IP.parseMany-            (PR.fromFold $ FL.takeEndBy_ (== lf) FL.drain)-            (S.unfold FH.read inh)-    ) -- >>= print- -- | Words by space wordsBy :: Handle -> IO Int wordsBy inh =-    (S.length $ S.wordsBy isSp FL.drain-        $ S.unfold FH.read inh) -- >>= print+    Stream.fold Fold.length+        $ Stream.wordsBy isSp Fold.drain+        $ Handle.read inh -- >>= print  #ifdef INSPECTION inspect $ hasNoTypeClasses 'wordsBy inspect $ 'wordsBy `hasNoType` ''Step-inspect $ 'wordsBy `hasNoType` ''IUF.ConcatState -- FH.read/UF.many-inspect $ 'wordsBy `hasNoType` ''MA.ArrayUnsafe  -- FH.read/A.read+inspect $ 'wordsBy `hasNoType` ''Unfold.ConcatState -- FH.read/UF.many+inspect $ 'wordsBy `hasNoType` ''MutArray.ArrayUnsafe  -- FH.read/A.read #endif  -- | Split on a word8 sequence. splitOnSeq :: String -> Handle -> IO Int splitOnSeq str inh =-    (S.length $ IP.splitOnSeq (toarr str) FL.drain-        $ S.unfold FH.read inh) -- >>= print+    (Stream.fold Fold.length $ Stream.splitSepBySeq_ (toarr str) Fold.drain+        $ Handle.read inh) -- >>= print  #ifdef INSPECTION -- inspect $ hasNoTypeClasses 'splitOnSeq -- inspect $ 'splitOnSeq `hasNoType` ''Step #endif +takeEndBy :: Word8 -> Handle -> IO Int+takeEndBy c inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBy (== c)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBy_ :: Word8 -> Handle -> IO Int+takeEndBy_ c inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBy_ (== c)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq :: String -> Handle -> IO Int+takeEndBySeq str inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq (toarr str)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq_ :: String -> Handle -> IO Int+takeEndBySeq_ str inh =+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq_ (toarr str)+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq100k :: Handle -> IO Int+takeEndBySeq100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq arr+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print++takeEndBySeq_100k :: Handle -> IO Int+takeEndBySeq_100k inh = do+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.takeEndBySeq_ arr+        $ Stream.filter (/= fromIntegral (ord 'a'))+        $ Handle.read inh) -- >>= print+ -- | Split on a word8 sequence. splitOnSeq100k :: Handle -> IO Int splitOnSeq100k inh = do-    arr <- A.fromStream $ IP.toStream $ S.fromSerial $ S.replicate 100000 123-    (S.length $ IP.splitOnSeq arr FL.drain-        $ S.unfold FH.read inh) -- >>= print+    arr <- Stream.fold Array.create $ Stream.replicate 100000 123+    (Stream.fold Fold.length+        $ Stream.splitSepBySeq_ arr Fold.drain+        $ Handle.read inh) -- >>= print  -- | Split on suffix sequence. splitOnSuffixSeq :: String -> Handle -> IO Int splitOnSuffixSeq str inh =-    (S.length $ IP.splitOnSuffixSeq (toarr str) FL.drain-        $ S.unfold FH.read inh) -- >>= print+    (Stream.fold Fold.length+        $ Stream.splitOnSuffixSeq False (toarr str) Fold.drain+        $ Handle.read inh) -- >>= print  #ifdef INSPECTION -- inspect $ hasNoTypeClasses 'splitOnSuffixSeq@@ -161,76 +162,135 @@ -- | Split on suffix sequence. splitWithSuffixSeq :: String -> Handle -> IO Int splitWithSuffixSeq str inh =-    S.length $ IP.splitWithSuffixSeq (toarr str) FL.drain-        $ S.unfold FH.read inh -- >>= print+    Stream.fold Fold.length+        $ Stream.splitOnSuffixSeq True (toarr str) Fold.drain+        $ Handle.read inh -- >>= print  o_1_space_reduce_read_split :: BenchEnv -> [Benchmark] o_1_space_reduce_read_split env =-    [ bgroup "split"-        [ mkBench "S.foldMany (FL.takeEndBy_ (== lf) FL.drain)" env-            $ \inh _ -> foldManySepBy inh-        , mkBench "S.parseMany (FL.takeEndBy_ (== lf) FL.drain)" env-            $ \inh _ -> parseManySepBy inh-        , mkBench "S.wordsBy isSpace FL.drain" env $ \inh _ ->-            wordsBy inh-        , mkBench "S.splitOn (== lf) FL.drain" env $ \inh _ ->+    -- NOTE: keep the benchmark names consistent with Data.Fold.takeEndBy*+    [ bgroup "FileSplitElem"+        [ mkBench "splitOn infix lf" env $ \inh _ ->             splitOn inh-        , mkBench "S.splitOnSuffix (== lf) FL.drain" env $ \inh _ ->-            splitOnSuffix inh-        , mkBench "S.splitWithSuffix (== lf) FL.drain" env $ \inh _ ->-            splitWithSuffix inh-        , mkBench "S.splitOnSeq \"\" FL.drain" env $ \inh _ ->+        ]+    -- splitting on a sequence+    , bgroup "FileSplitSeq"+        [+          mkBench "wordsBy infix isSpace" env $ \inh _ ->+            wordsBy inh++        -- Infix+        , mkBench "splitOnSeq empty infix" env $ \inh _ ->             splitOnSeq "" inh-        , mkBench "S.splitOnSuffixSeq \"\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "" inh-        , mkBench "S.splitOnSeq \"\\n\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq single infix lf" env $ \inh _ ->             splitOnSeq "\n" inh-        , mkBench "S.splitOnSuffixSeq \"\\n\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "\n" inh-        , mkBench "S.splitOnSeq \"a\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq single infix a" env $ \inh _ ->             splitOnSeq "a" inh-        , mkBench "S.splitOnSeq \"\\r\\n\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq word infix crlf" env $ \inh _ ->             splitOnSeq "\r\n" inh-        , mkBench "S.splitOnSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->-            splitOnSuffixSeq "\r\n" inh-        , mkBench "S.splitWithSuffixSeq \"\\r\\n\" FL.drain" env $ \inh _ ->-            splitWithSuffixSeq "\r\n" inh-        , mkBench "S.splitOnSeq \"aa\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq word infix aa" env $ \inh _ ->             splitOnSeq "aa" inh-        , mkBench "S.splitOnSeq \"aaaa\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq word infix aaaa" env $ \inh _ ->             splitOnSeq "aaaa" inh-        , mkBench "S.splitOnSeq \"abcdefgh\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq word infix abcdefgh" env $ \inh _ ->             splitOnSeq "abcdefgh" inh-        , mkBench "S.splitOnSeq \"abcdefghi\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq KR infix abcdefghi" env $ \inh _ ->             splitOnSeq "abcdefghi" inh-        , mkBench "S.splitOnSeq \"catcatcatcatcat\" FL.drain" env $ \inh _ ->+        , mkBench "splitOnSeq KR infix catcatcatcatcat" env $ \inh _ ->             splitOnSeq "catcatcatcatcat" inh-        , mkBench "S.splitOnSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"+        , mkBench "splitOnSeq KR infix abcdefghijklmnopqrstuvwxyz"             env $ \inh _ -> splitOnSeq "abcdefghijklmnopqrstuvwxyz" inh-        , mkBench "S.splitOnSeq 100k long pattern"+        , mkBench "splitOnSeq KR infix 100k long pattern"             env $ \inh _ -> splitOnSeq100k inh-        , mkBenchSmall "S.splitOnSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"++        -- Suffix+        , mkBench "splitOnSuffixSeq empty suffix" env $ \inh _ ->+            splitOnSuffixSeq "" inh+        , mkBench "splitOnSuffixSeq single suffix lf" env $ \inh _ ->+            splitOnSuffixSeq "\n" inh+        , mkBench "splitOnSuffixSeq word suffix crlf" env $ \inh _ ->+            splitOnSuffixSeq "\r\n" inh+        , mkBenchSmall "splitOnSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz"             env $ \inh _ -> splitOnSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh-        , mkBenchSmall "S.splitWithSuffixSeq \"abcdefghijklmnopqrstuvwxyz\" FL.drain"++        -- Suffix with separator+        , mkBench "splitWithSuffixSeq single suffix lf" env $ \inh _ ->+            splitWithSuffixSeq "\n" inh+        , mkBench "splitWithSuffixSeq word suffix crlf" env $ \inh _ ->+            splitWithSuffixSeq "\r\n" inh+        , mkBench "splitWithSuffixSeq KR suffix abcdefghi" env $ \inh _ ->+            splitWithSuffixSeq "abcdefghi" inh+        , mkBenchSmall "splitWithSuffixSeq KR suffix abcdefghijklmnopqrstuvwxyz"             env $ \inh _ -> splitWithSuffixSeq "abcdefghijklmnopqrstuvwxyz" inh         ]++    , bgroup "FileTakeSeq"+        [+        {-+          mkBench "takeEndBySeq empty" env $ \inh _ ->+                takeEndBySeq "" inh+        -}+        -- IMPORTANT: the pattern must contain a, because we filter a's out+        -- from the stream so that we do not terminate too early and+        -- unpredictably.+          mkBench "takeEndBy" env $ \inh _ ->+            takeEndBy (fromIntegral $ ord 'a') inh+        , mkBench "takeEndBy_" env $ \inh _ ->+            takeEndBy_ (fromIntegral $ ord 'a') inh+        , mkBench "takeEndBySeq single a" env $ \inh _ ->+            takeEndBySeq "a" inh+        , mkBench "takeEndBySeq word aa" env $ \inh _ ->+            takeEndBySeq "aa" inh+        , mkBench "takeEndBySeq word aaaa" env $ \inh _ ->+            takeEndBySeq "aaaa" inh+        , mkBench "takeEndBySeq word abcdefgh" env $ \inh _ ->+            takeEndBySeq "abcdefgh" inh+        , mkBench "takeEndBySeq KR abcdefghi" env $ \inh _ ->+            takeEndBySeq "abcdefghi" inh+        , mkBench "takeEndBySeq KR catcatcatcatcat" env $ \inh _ ->+            takeEndBySeq "catcatcatcatcat" inh+        , mkBench "takeEndBySeq KR abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> takeEndBySeq "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq KR 100k long pattern"+            env $ \inh _ -> takeEndBySeq100k inh++        {-+        , mkBench "takeEndBySeq_ empty" env $ \inh _ ->+            takeEndBySeq_ "" inh+        -}+        , mkBench "takeEndBySeq_ single a" env $ \inh _ ->+            takeEndBySeq_ "a" inh+        , mkBench "takeEndBySeq_ word aa" env $ \inh _ ->+            takeEndBySeq_ "aa" inh+        , mkBench "takeEndBySeq_ word aaaa" env $ \inh _ ->+            takeEndBySeq_ "aaaa" inh+        , mkBench "takeEndBySeq_ word abcdefgh" env $ \inh _ ->+            takeEndBySeq_ "abcdefgh" inh+        , mkBench "takeEndBySeq_ KR abcdefghi" env $ \inh _ ->+            takeEndBySeq_ "abcdefghi" inh+        , mkBench "takeEndBySeq_ KR catcatcatcatcat" env $ \inh _ ->+            takeEndBySeq_ "catcatcatcatcat" inh+        , mkBench "takeEndBySeq_ KR abcdefghijklmnopqrstuvwxyz"+            env $ \inh _ -> takeEndBySeq_ "abcdefghijklmnopqrstuvwxyz" inh+        , mkBench "takeEndBySeq_ KR 100k long pattern"+            env $ \inh _ -> takeEndBySeq_100k inh+        ]     ]  -- | Split on a character sequence. splitOnSeqUtf8 :: String -> Handle -> IO Int splitOnSeqUtf8 str inh =-    (S.length $ IP.splitOnSeq (A.fromList str) FL.drain-        $ IP.fromStream-        $ IUS.decodeUtf8Arrays-        $ IFH.readChunks inh) -- >>= print+    (Stream.fold Fold.length+        $ Stream.splitSepBySeq_ (Array.fromList str) Fold.drain+        $ Unicode.decodeUtf8Chunks+        $ Handle.readChunks inh) -- >>= print  o_1_space_reduce_toChunks_split :: BenchEnv -> [Benchmark] o_1_space_reduce_toChunks_split env =-    [ bgroup "split/toChunks"-        [ mkBenchSmall ("S.splitOnSeqUtf8 \"abcdefgh\" FL.drain "-            ++ ". US.decodeUtf8Arrays") env $ \inh _ ->-                splitOnSeqUtf8 "abcdefgh" inh-        , mkBenchSmall "S.splitOnSeqUtf8 \"abcdefghijklmnopqrstuvwxyz\" FL.drain"+    [ bgroup "FileSplitSeqUtf8"+        [ mkBenchSmall "splitOnSeqUtf8 word abcdefgh"+            env $ \inh _ -> splitOnSeqUtf8 "abcdefgh" inh+        , mkBenchSmall "splitOnSeqUtf8 KR abcdefghijklmnopqrstuvwxyz"             env $ \inh _ -> splitOnSeqUtf8 "abcdefghijklmnopqrstuvwxyz" inh         ]     ]
benchmark/Streamly/Benchmark/Data/Stream/StreamD.hs view
@@ -448,7 +448,7 @@ unfoldManyRepl :: Int -> Int -> Int -> IO () unfoldManyRepl outer inner n =     S.drain-         $ S.unfoldMany+         $ S.unfoldEach                UF.replicateM                (S.map ((inner,) . return) (sourceUnfoldrMN outer n))
− benchmark/Streamly/Benchmark/Data/Stream/StreamK.hs 
@@ -1,934 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.Stream.StreamK--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -Wno-orphans #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Main (main) where--#if !MIN_VERSION_base(4,18,0)-import Control.Applicative (liftA2)-#endif-import Control.Monad (when)-import Data.Maybe (isJust)-import System.Random (randomRIO)-import Prelude hiding-    ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init, iterate-    , repeat, replicate-    )--import qualified Prelude as P-import qualified Data.List as List--import qualified Streamly.Internal.Data.StreamK as S--import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark, defaultMain)--import Streamly.Benchmark.Common--#ifdef INSPECTION-import Test.Inspection-#endif--{---Benchmarks that need to be added---- fromList---- bindWith--- concatPairsWith--- apWith--- apSerial--- apSerialDiscardFst--- apSerialDiscardSnd---- the--- serial--- consMStream--- withLocal--- mfix---- elem--- notElem--- all--- any--- minimum--- minimumBy--- maximum--- maximumBy--- findIndices--- lookup--- findM--- find--- (!!)---- foldlM'--- foldlT--- foldlx'--- foldlMx'--- fold---- sequence---- foldrSM--- buildS--- buildM--- augmentS--- augmentSM--- foldr--- foldr1--- foldrM--- foldrT---- intersperseM--- insertBy--- deleteBy--- reverse--- mapMaybe---- zipWithM--- mergeBy--- mergeByM---- toStreamK (Probably can be skipped)--- hoist---- scanlx'---}------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.StreamK m a--{-# INLINE unfoldr #-}-unfoldr :: Int -> Int -> Stream m Int-unfoldr streamLen n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + streamLen-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => Int -> Int -> Stream m Int-unfoldrM streamLen n = S.unfoldrMWith S.consM step n-    where-    step cnt =-        if cnt > n + streamLen-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE repeat #-}-repeat :: Int -> Int -> Stream m Int-repeat streamLen = S.take streamLen . S.repeat--{-# INLINE repeatM #-}-repeatM :: Monad m => Int -> Int -> Stream m Int-repeatM streamLen = S.take streamLen . S.repeatM . return--{-# INLINE replicate #-}-replicate :: Int -> Int -> Stream m Int-replicate = S.replicate--{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> Int -> Stream m Int-replicateM streamLen = S.replicateMWith S.consM streamLen . return--{-# INLINE iterate #-}-iterate :: Int -> Int -> Stream m Int-iterate streamLen = S.take streamLen . S.iterate (+1)--{-# INLINE iterateM #-}-iterateM :: Monad m => Int -> Int -> Stream m Int-iterateM streamLen = S.take streamLen . S.iterateM (return . (+1)) . return--{-# INLINE fromFoldable #-}-fromFoldable :: Int -> Int -> Stream m Int-fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]--{-# INLINE fromFoldableM #-}-fromFoldableM :: Monad m => Int -> Int -> Stream m Int-fromFoldableM streamLen n =-    List.foldr S.consM S.nil (Prelude.fmap return [n..n+streamLen])--{-# INLINABLE concatMapFoldableWith #-}-concatMapFoldableWith :: P.Foldable f-    => (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> f a-    -> Stream m b-concatMapFoldableWith f g = P.foldr (f . g) S.nil--{-# INLINE concatMapFoldableSerial #-}-concatMapFoldableSerial :: Int -> Int -> Stream m Int-concatMapFoldableSerial streamLen n =-    concatMapFoldableWith S.append S.fromPure [n..n+streamLen]--{-# INLINE concatMapFoldableSerialM #-}-concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int-concatMapFoldableSerialM streamLen n =-    concatMapFoldableWith S.append (S.fromEffect . return) [n..n+streamLen]------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE drain #-}-drain :: Monad m => Stream m a -> m ()-drain = S.drain--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ = S.mapM_ (\_ -> return ())--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t--{-# INLINE init #-}-init :: Monad m => Stream m a -> m ()-init s = do-    t <- S.init s-    P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: Monad m => Stream m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-nullTail :: Monad m => Stream m Int -> m ()-nullTail s = do-    r <- S.null s-    when (not r) $ S.tail s >>= P.mapM_ nullTail--{-# INLINE headTail #-}-headTail :: Monad m => Stream m Int -> m ()-headTail s = do-    h <- S.head s-    when (isJust h) $ S.tail s >>= P.mapM_ headTail--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = S.toList--{-# INLINE foldl' #-}-foldl' :: Monad m => Stream m Int -> m Int-foldl' = S.foldl' (+) 0--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last = S.last------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE composeN #-}-composeN-    :: Monad m-    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =-    case n of-        1 -> drain . f-        2 -> drain . f . f-        3 -> drain . f . f . f-        4 -> drain . f . f . f . f-        _ -> undefined--{-# INLINE scanl' #-}-scanl' :: Monad m => Int -> Stream m Int -> m ()-scanl' n = composeN n $ S.scanl' (+) 0--{-# INLINE map #-}-map :: Monad m => Int -> Stream m Int -> m ()-map n = composeN n $ S.map (+ 1)--{-# INLINE fmapK #-}-fmapK :: Monad m => Int -> Stream m Int -> m ()-fmapK n = composeN n $ P.fmap (+ 1)--{-# INLINE mapM #-}-mapM :: Monad m => Int -> Stream m Int -> m ()-mapM n = composeN n $ S.mapMWith S.consM return--{-# INLINE mapMSerial #-}-mapMSerial :: Monad m => Int -> Stream m Int -> m ()-mapMSerial n = composeN n $ S.mapMSerial return--{-# INLINE filterEven #-}-filterEven :: Monad m => Int -> Stream m Int -> m ()-filterEven n = composeN n $ S.filter even--{-# INLINE filterAllOut #-}-filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllOut streamLen n = composeN n $ S.filter (> streamLen)--{-# INLINE filterAllIn #-}-filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)--{-# INLINE _takeOne #-}-_takeOne :: Monad m => Int -> Stream m Int -> m ()-_takeOne n = composeN n $ S.take 1--{-# INLINE takeAll #-}-takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()-takeAll streamLen n = composeN n $ S.take streamLen--{-# INLINE takeWhileTrue #-}-takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)--{-# INLINE dropOne #-}-dropOne :: Monad m => Int -> Stream m Int -> m ()-dropOne n = composeN n $ S.drop 1--{-# INLINE dropAll #-}-dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()-dropAll streamLen n = composeN n $ S.drop streamLen--{-# INLINE dropWhileTrue #-}-dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)--{-# INLINE dropWhileFalse #-}-dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)--{-# INLINE foldrS #-}-foldrS :: Monad m => Int -> Stream m Int -> m ()-foldrS n = composeN n $ S.foldrS S.cons S.nil--{-# INLINE foldlS #-}-foldlS :: Monad m => Int -> Stream m Int -> m ()-foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil--{-# INLINE intersperse #-}-intersperse :: Monad m => Int -> Int -> Stream m Int -> m ()-intersperse streamLen n = composeN n $ S.intersperse streamLen------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------{-# INLINE iterateSource #-}-iterateSource-    :: Monad m => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)-    where-        f (0 :: Int) m = g m-        f x m = g (f (x P.- 1) m)---- this is quadratic-{-# INLINE iterateScan #-}-iterateScan :: Monad m => Int -> Int -> Int -> Stream m Int-iterateScan iterStreamLen maxIters =-    iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)---- this is quadratic-{-# INLINE iterateDropWhileFalse #-}-iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileFalse streamLen iterStreamLen maxIters =-    iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)--{-# INLINE iterateMapM #-}-iterateMapM :: Monad m => Int -> Int -> Int -> Stream m Int-iterateMapM iterStreamLen =-    iterateSource iterStreamLen (S.mapMWith S.consM return)--{-# INLINE iterateFilterEven #-}-iterateFilterEven :: Monad m => Int -> Int -> Int -> Stream m Int-iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)--{-# INLINE iterateTakeAll #-}-iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> Stream m Int-iterateTakeAll streamLen iterStreamLen =-    iterateSource iterStreamLen (S.take streamLen)--{-# INLINE iterateDropOne #-}-iterateDropOne :: Monad m => Int -> Int -> Int -> Stream m Int-iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)--{-# INLINE iterateDropWhileTrue #-}-iterateDropWhileTrue ::-    Monad m => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileTrue streamLen iterStreamLen =-    iterateSource iterStreamLen (S.dropWhile (<= streamLen))------------------------------------------------------------------------------------ Zipping----------------------------------------------------------------------------------{-# INLINE zipWith #-}-zipWith :: Monad m => Stream m Int -> m ()-zipWith src = drain $ S.zipWith (,) src src--{-# INLINE zipWithM #-}-zipWithM :: Monad m => Stream m Int -> m ()-zipWithM src = drain $ S.zipWithM (curry return) src src--{-# INLINE sortByK #-}-sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a-sortByK f = S.mergeMapWith (S.mergeBy f) S.fromPure--{-# INLINE sortBy #-}-sortBy :: Monad m => Stream m Int -> m ()-sortBy = drain . sortByK compare------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-scanMap :: Monad m => Int -> Stream m Int -> m ()-scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0--{-# INLINE dropMap #-}-dropMap :: Monad m => Int -> Stream m Int -> m ()-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1--{-# INLINE dropScan #-}-dropScan :: Monad m => Int -> Stream m Int -> m ()-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1--{-# INLINE takeDrop #-}-takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen--{-# INLINE takeScan #-}-takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()-takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen--{-# INLINE takeMap #-}-takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()-takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen--{-# INLINE filterDrop #-}-filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)--{-# INLINE filterTake #-}-filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()-filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)--{-# INLINE filterScan #-}-filterScan :: Monad m => Int -> Stream m Int -> m ()-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)--{-# INLINE filterMap #-}-filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()-filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)------------------------------------------------------------------------------------ ConcatMap------------------------------------------------------------------------------------ concatMap unfoldrM/unfoldrM--{-# INLINE concatMap #-}-concatMap :: Int -> Int -> Int -> IO ()-concatMap outer inner n =-    S.drain $ S.concatMap-        (\_ -> unfoldrM inner n)-        (unfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMap-#endif---- concatMap unfoldr/unfoldr--{-# INLINE concatMapPure #-}-concatMapPure :: Int -> Int -> Int -> IO ()-concatMapPure outer inner n =-    S.drain $ S.concatMap-        (\_ -> unfoldr inner n)-        (unfoldr outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapPure-#endif---- concatMap replicate/unfoldrM--{-# INLINE concatMapRepl #-}-concatMapRepl :: Int -> Int -> Int -> IO ()-concatMapRepl outer inner n =-    S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapRepl-#endif---- concatMapWith--{-# INLINE sourceConcatMapId #-}-sourceConcatMapId :: Monad m-    => Int -> Int -> Stream m (Stream m Int)-sourceConcatMapId val n =-    S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]--{-# INLINE concatMapBySerial #-}-concatMapBySerial :: Int -> Int -> Int -> IO ()-concatMapBySerial outer inner n =-    S.drain $ S.concatMapWith S.append-        (unfoldrM inner)-        (unfoldrM outer n)------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------instance Monad m => Applicative (S.StreamK m) where-    {-# INLINE pure #-}-    pure = S.fromPure--    {-# INLINE (<*>) #-}-    (<*>) = S.crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = S.crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = S.crossApplyFst---- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,--- the monad instance of StreamD is slower than StreamK after foldr/build--- fusion.-instance Monad m => Monad (S.StreamK m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip S.concatMap--{-# INLINE drainApplicative #-}-drainApplicative :: Monad m => Stream m Int -> m ()-drainApplicative s = drain $ do-    (+) <$> s <*> s--{-# INLINE drainMonad #-}-drainMonad :: Monad m => Stream m Int -> m ()-drainMonad s = drain $ do-    x <- s-    y <- s-    return $ x + y--{-# INLINE drainMonad3 #-}-drainMonad3 :: Monad m => Stream m Int -> m ()-drainMonad3 s = drain $ do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutMonad #-}-filterAllOutMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllOutMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllInMonad #-}-filterAllInMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllInMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists------------------------------------------------------------------------------------ There are several list benchmarks here for comparison with lists. It is easy--- and convenient to see the comparisons when they are here, otherwise we'll--- have to add a separate module for list benchmarks with the same names and--- then add a comparison in bench.sh.--{-# INLINE unfoldrList #-}-unfoldrList :: Int -> Int -> [Int]-unfoldrList maxval n = List.unfoldr step n-    where-    step cnt =-        if cnt > n + maxval-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else []------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.StreamK"--o_1_space_generation :: Int -> Benchmark-o_1_space_generation streamLen =-    bgroup "generation"-        [ benchFold "unfoldr" drain (unfoldr streamLen)-        , benchFold "unfoldrM" drain (unfoldrM streamLen)-        , benchFold "repeat" drain (repeat streamLen)-        , benchFold "repeatM" drain (repeatM streamLen)-        , benchFold "replicate" drain (replicate streamLen)-        , benchFold "replicateM" drain (replicateM streamLen)-        , benchFold "iterate" drain (iterate streamLen)-        , benchFold "iterateM" drain (iterateM streamLen)--        , benchFold "fromFoldable"  drain (fromFoldable streamLen)-        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)--        -- appends-        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)-        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)-        ]--o_1_space_elimination :: Int -> Benchmark-o_1_space_elimination streamLen =-    bgroup "elimination"-        [ benchFold "toNull"   drain   (unfoldrM streamLen)-        , benchFold "mapM_"    mapM_    (unfoldrM streamLen)-        , benchFold "uncons"   uncons   (unfoldrM streamLen)-        , benchFold "init"   init     (unfoldrM streamLen)-        , benchFold "foldl'" foldl'    (unfoldrM streamLen)-        , benchFold "last"   last     (unfoldrM streamLen)-        ]--o_1_space_nested :: Int -> Benchmark-o_1_space_nested streamLen =-    bgroup "nested"-        [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)-        , benchFold "drainMonad"   drainMonad   (unfoldrM streamLen2)-        , benchFold "drainMonad3"  drainMonad3  (unfoldrM streamLen3)-        , benchFold "filterAllInMonad"  filterAllInMonad  (unfoldrM streamLen2)-        , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)-        , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)-        , benchFold "drainMonad (pure)"   drainMonad   (unfoldr streamLen2)-        , benchFold "drainMonad3 (pure)"  drainMonad3  (unfoldr streamLen3)-        , benchFold "filterAllInMonad (pure)"  filterAllInMonad  (unfoldr streamLen2)-        , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--o_1_space_transformation :: Int -> Benchmark-o_1_space_transformation streamLen =-    bgroup "transformation"-        [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)-        , benchFold "scanl'"   (scanl' 1) (unfoldrM streamLen)-        , benchFold "map"    (map  1) (unfoldrM streamLen)-        , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)-        , benchFold "mapM"   (mapM 1) (unfoldrM streamLen)-        , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)-        ]--o_1_space_transformationX4 :: Int -> Benchmark-o_1_space_transformationX4 streamLen =-    bgroup "transformationX4"-        [ benchFold "scanl'"   (scanl' 4) (unfoldrM streamLen)-        , benchFold "map"    (map  4) (unfoldrM streamLen)-        , benchFold "fmap"   (fmapK 4) (unfoldrM streamLen)-        , benchFold "mapM"   (mapM 4) (unfoldrM streamLen)-        , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)-        -- XXX this is horribly slow-        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)-        ]--o_1_space_concat :: Int -> Benchmark-o_1_space_concat streamLen =-    bgroup "concat"-        [ benchIOSrc1 "concatMapPure (n of 1)"-            (concatMapPure streamLen 1)-        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"-            (concatMapPure streamLen2 streamLen2)-        , benchIOSrc1 "concatMapPure (1 of n)"-            (concatMapPure 1 streamLen)--        , benchIOSrc1 "concatMap (n of 1)"-            (concatMap streamLen 1)-        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"-            (concatMap streamLen2 streamLen2)-        , benchIOSrc1 "concatMap (1 of n)"-            (concatMap 1 streamLen)--        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"-            (concatMapRepl streamLen2 streamLen2)--        -- This is for comparison with concatMapFoldableWith-        , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"-            (S.drain-                . S.concatMapWith S.append id-                . sourceConcatMapId streamLen)--        , benchIOSrc1 "concatMapBy serial (n of 1)"-            (concatMapBySerial streamLen 1)-        , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"-            (concatMapBySerial streamLen2 streamLen2)-        , benchIOSrc1 "concatMapBy serial (1 of n)"-            (concatMapBySerial 1 streamLen)-        , benchFold "sortBy" sortBy (unfoldrM streamLen)-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop--o_1_space_filtering :: Int -> Benchmark-o_1_space_filtering streamLen =-    bgroup "filtering"-        [ benchFold "filter-even"     (filterEven     1) (unfoldrM streamLen)-        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)-        ]--o_1_space_filteringX4 :: Int -> Benchmark-o_1_space_filteringX4 streamLen =-    bgroup "filteringX4"-        [ benchFold "filter-even"     (filterEven     4) (unfoldrM streamLen)-        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)-        ]--o_1_space_zipping :: Int -> Benchmark-o_1_space_zipping streamLen =-    bgroup "zipping"-        [ benchFold "zipWith" zipWith (unfoldrM streamLen)-        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)-        ]--o_1_space_mixed :: Int -> Benchmark-o_1_space_mixed streamLen =-    bgroup "mixed"-        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)-        ]--o_1_space_mixedX2 :: Int -> Benchmark-o_1_space_mixedX2 streamLen =-    bgroup "mixedX2"-        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)-        ]--o_1_space_mixedX4 :: Int -> Benchmark-o_1_space_mixedX4 streamLen =-    bgroup "mixedX4"-        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)-        ]--o_1_space_list :: Int -> Benchmark-o_1_space_list streamLen =-    bgroup "list"-      [ bgroup "elimination"-        [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)-        ]-      , bgroup "nested"-        [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)-        , benchList "toNull"   toNullNestedList (unfoldrList streamLen2)-        , benchList "toNull3"  toNullNestedList3 (unfoldrList streamLen3)-        , benchList "filterAllIn"  filterAllInNestedList (unfoldrList streamLen2)-        , benchList "filterAllOut"  filterAllOutNestedList (unfoldrList streamLen2)-        ]-      ]-    where--    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--o_1_space :: Int -> Benchmark-o_1_space streamLen =-    bgroup (o_1_space_prefix moduleName)-      [ o_1_space_generation streamLen-      , o_1_space_elimination streamLen-      , o_1_space_nested streamLen-      , o_1_space_transformation streamLen-      , o_1_space_transformationX4 streamLen-      , o_1_space_concat streamLen-      , o_1_space_filtering streamLen-      , o_1_space_filteringX4 streamLen-      , o_1_space_zipping streamLen-      , o_1_space_mixed streamLen-      , o_1_space_mixedX2 streamLen-      , o_1_space_mixedX4 streamLen-      , o_1_space_list streamLen-      ]--o_n_heap :: Int -> Benchmark-o_n_heap streamLen =-    bgroup (o_n_heap_prefix moduleName)-      [ bgroup "transformation"-        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)-        ]-      ]--{-# INLINE benchK #-}-benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark-benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f--o_n_stack :: Int -> Int -> Int -> Benchmark-o_n_stack streamLen iterStreamLen maxIters =-    bgroup (o_n_stack_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "tail"   tail     (unfoldrM streamLen)-        , benchFold "nullTail" nullTail (unfoldrM streamLen)-        , benchFold "headTail" headTail (unfoldrM streamLen)-        ]-      , bgroup "transformation"-        [-          -- XXX why do these need so much stack-          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)-        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)-        ]-      , bgroup "transformationX4"-        [-          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)-        ]-      , bgroup "iterated"-        [ benchK "mapM"                 (iterateMapM iterStreamLen maxIters)-        , benchK "scan(1/10)"           (iterateScan iterStreamLen maxIters)-        , benchK "filterEven"           (iterateFilterEven iterStreamLen maxIters)-        , benchK "takeAll"              (iterateTakeAll streamLen iterStreamLen maxIters)-        , benchK "dropOne"              (iterateDropOne iterStreamLen maxIters)-        , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)-        , benchK "dropWhileTrue"        (iterateDropWhileTrue streamLen iterStreamLen maxIters)-        ]-      ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop--o_n_space :: Int -> Benchmark-o_n_space streamLen =-    bgroup (o_n_space_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "toList" toList   (unfoldrM streamLen)-        ]-      ]--{-# INLINE benchList #-}-benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark-benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f--main :: IO ()-main =-    defaultMain-        [ o_1_space streamLen-        , o_n_stack streamLen iterStreamLen maxIters-        , o_n_heap streamLen-        , o_n_space streamLen-        ]--    where--    streamLen = 100000-    maxIters = 10000-    iterStreamLen = 10
− benchmark/Streamly/Benchmark/Data/Stream/StreamKAlt.hs 
@@ -1,455 +0,0 @@-{-# OPTIONS_GHC -Wno-deprecations #-}---- |--- Module      : Streamly.Benchmark.Data.Stream.StreamDK--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Main (main) where---- import Control.Monad (when)--- import Data.Maybe (isJust)-import Prelude hiding ()--- import qualified Prelude as P--- import qualified Data.List as List--import qualified Streamly.Internal.Data.StreamK.Alt as S--- import qualified Streamly.Internal.Data.Stream.Common as SP--- import qualified Streamly.Internal.Data.SVar as S--import Streamly.Benchmark.Common-import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)--value :: Int-value = 100000-{--value2, value3, value16, maxValue :: Int-value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop-value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop-value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop-maxValue = value--}------------------------------------------------------------------------------------ Benchmark ops-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE sourceUnfoldr #-}-sourceUnfoldr :: Monad m => Int -> Stream m Int-sourceUnfoldr n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + value-        then Nothing-        else Just (cnt, cnt + 1)--{--{-# INLINE sourceUnfoldrN #-}-sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrN m n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + m-        then Nothing-        else Just (cnt, cnt + 1)--}--{-# INLINE sourceUnfoldrM #-}-sourceUnfoldrM :: Monad m => Int -> Stream m Int-sourceUnfoldrM n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + value-        then return Nothing-        else return (Just (cnt, cnt + 1))--{--{-# INLINE sourceUnfoldrMN #-}-sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int-sourceUnfoldrMN m n = S.unfoldrM step n-    where-    step cnt =-        if cnt > n + m-        then return Nothing-        else return (Just (cnt, cnt + 1))--}--{--{-# INLINE sourceFromEnum #-}-sourceFromEnum :: Monad m => Int -> Stream m Int-sourceFromEnum n = S.enumFromStepN n 1 value--}--{--{-# INLINE sourceFromFoldable #-}-sourceFromFoldable :: Int -> Stream m Int-sourceFromFoldable n = S.fromFoldable [n..n+value]--}--{--{-# INLINE sourceFromFoldableM #-}-sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int-sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])--}--{--{-# INLINE sourceFoldMapWith #-}-sourceFoldMapWith :: Int -> Stream m Int-sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]--{-# INLINE sourceFoldMapWithM #-}-sourceFoldMapWithM :: Monad m => Int -> Stream m Int-sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]--}------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE runStream #-}-runStream :: Monad m => Stream m a -> m ()-runStream = S.drain--- runStream = S.mapM_ (\_ -> return ())--{--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ = S.mapM_ (\_ -> return ())--}--{-# INLINE toNull #-}-toNull :: Monad m => Stream m Int -> m ()-toNull = runStream--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do-    r <- S.uncons s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons t--{--{-# INLINE init #-}-init :: (Monad m, S.IsStream t) => t m a -> m ()-init s = do-    t <- S.init s-    P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: (Monad m, S.IsStream t) => t m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-{-# INLINE headTail #-}-{-# INLINE zip #-}-nullTail, headTail, zip-    :: Monad m-    => Stream m Int -> m ()--nullTail s = do-    r <- S.null s-    when (not r) $ S.tail s >>= P.mapM_ nullTail--headTail s = do-    h <- S.head s-    when (isJust h) $ S.tail s >>= P.mapM_ headTail--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = S.toList--{-# INLINE foldl #-}-foldl :: Monad m => Stream m Int -> m Int-foldl  = S.foldl' (+) 0--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last   = S.last--}------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{--{-# INLINE transform #-}-transform :: Monad m => Stream m a -> m ()-transform = runStream--{-# INLINE composeN #-}-composeN-    :: Monad m-    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =-    case n of-        1 -> transform . f-        2 -> transform . f . f-        3 -> transform . f . f . f-        4 -> transform . f . f . f . f-        _ -> undefined--}--{--{-# INLINE scan #-}-{-# INLINE map #-}-{-# INLINE fmap #-}-{-# INLINE filterEven #-}-{-# INLINE filterAllOut #-}-{-# INLINE filterAllIn #-}-{-# INLINE takeOne #-}-{-# INLINE takeAll #-}-{-# INLINE takeWhileTrue #-}-{-# INLINE dropOne #-}-{-# INLINE dropAll #-}-{-# INLINE dropWhileTrue #-}-{-# INLINE dropWhileFalse #-}-{-# INLINE foldlS #-}-{-# INLINE concatMap #-}-scan, map, fmap, filterEven, filterAllOut,-    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,-    dropWhileTrue, dropWhileFalse, foldlS, concatMap-    :: Monad m-    => Int -> Stream m Int -> m ()--{-# INLINE mapM #-}-{-# INLINE mapMSerial #-}-{-# INLINE intersperse #-}-mapM, mapMSerial, intersperse-    :: S.MonadAsync m => Int -> Stream m Int -> m ()--scan           n = composeN n $ S.scanl' (+) 0-map            n = composeN n $ P.fmap (+1)-fmap           n = composeN n $ P.fmap (+1)-mapM           n = composeN n $ S.mapM return-mapMSerial     n = composeN n $ S.mapMSerial return-filterEven     n = composeN n $ S.filter even-filterAllOut   n = composeN n $ S.filter (> maxValue)-filterAllIn    n = composeN n $ S.filter (<= maxValue)-takeOne        n = composeN n $ S.take 1-takeAll        n = composeN n $ S.take maxValue-takeWhileTrue  n = composeN n $ S.takeWhile (<= maxValue)-dropOne        n = composeN n $ S.drop 1-dropAll        n = composeN n $ S.drop maxValue-dropWhileTrue  n = composeN n $ S.dropWhile (<= maxValue)-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)-foldlS         n = composeN n $ S.foldlS (flip S.cons) S.nil--- We use a (sqrt n) element stream as source and then concat the same stream--- for each element to produce an n element stream.-concatMap      n = composeN n $ (\s -> S.concatMap (\_ -> s) s)-intersperse    n = composeN n $ S.intersperse maxValue------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------iterStreamLen, maxIters :: Int-iterStreamLen = 10-maxIters = 10000--{-# INLINE iterateSource #-}-iterateSource-    :: S.MonadAsync m-    => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)-    where-        f (0 :: Int) m = g m-        f x m = g (f (x P.- 1) m)--{-# INLINE iterateMapM #-}-{-# INLINE iterateScan #-}-{-# INLINE iterateFilterEven #-}-{-# INLINE iterateTakeAll #-}-{-# INLINE iterateDropOne #-}-{-# INLINE iterateDropWhileFalse #-}-{-# INLINE iterateDropWhileTrue #-}-iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,-    iterateDropWhileFalse, iterateDropWhileTrue-    :: S.MonadAsync m-    => Int -> Stream m Int---- this is quadratic-iterateScan            = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)-iterateDropWhileFalse  = iterateSource (S.dropWhile (> maxValue))-                                       (maxIters `div` 10)--iterateMapM            = iterateSource (S.mapM return) maxIters-iterateFilterEven      = iterateSource (S.filter even) maxIters-iterateTakeAll         = iterateSource (S.take maxValue) maxIters-iterateDropOne         = iterateSource (S.drop 1) maxIters-iterateDropWhileTrue   = iterateSource (S.dropWhile (<= maxValue)) maxIters------------------------------------------------------------------------------------ Zipping and concat----------------------------------------------------------------------------------zip src       = transform $ S.zipWith (,) src src--{-# INLINE concatMapRepl4xN #-}-concatMapRepl4xN :: Monad m => Stream m Int -> m ()-concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-{-# INLINE dropMap #-}-{-# INLINE dropScan #-}-{-# INLINE takeDrop #-}-{-# INLINE takeScan #-}-{-# INLINE takeMap #-}-{-# INLINE filterDrop #-}-{-# INLINE filterTake #-}-{-# INLINE filterScan #-}-{-# INLINE filterMap #-}-scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,-    filterTake, filterScan, filterMap-    :: Monad m => Int -> Stream m Int -> m ()--scanMap    n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0-dropMap    n = composeN n $ S.map (subtract 1) . S.drop 1-dropScan   n = composeN n $ S.scanl' (+) 0 . S.drop 1-takeDrop   n = composeN n $ S.drop 1 . S.take maxValue-takeScan   n = composeN n $ S.scanl' (+) 0 . S.take maxValue-takeMap    n = composeN n $ S.map (subtract 1) . S.take maxValue-filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)-filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)-filterMap  n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------{-# INLINE toNullApNested #-}-toNullApNested :: Monad m => Stream m Int -> m ()-toNullApNested s = runStream $ do-    (+) <$> s <*> s--{-# INLINE toNullNested #-}-toNullNested :: Monad m => Stream m Int -> m ()-toNullNested s = runStream $ do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNested3 #-}-toNullNested3 :: Monad m => Stream m Int -> m ()-toNullNested3 s = runStream $ do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNested #-}-filterAllOutNested-    :: Monad m-    => Stream m Int -> m ()-filterAllOutNested str = runStream $ do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllInNested #-}-filterAllInNested-    :: Monad m-    => Stream m Int -> m ()-filterAllInNested str = runStream $ do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists----------------------------------------------------------------------------------{-# INLINE sourceUnfoldrList #-}-sourceUnfoldrList :: Int -> Int -> [Int]-sourceUnfoldrList maxval n = List.unfoldr step n-    where-    step cnt =-        if cnt > n + maxval-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else []--}------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Stream.StreamDK"--o_1_space :: [Benchmark]-o_1_space =-    [ bgroup (o_1_space_prefix moduleName)-      [ bgroup "generation"-        [ benchFold "unfoldr"       toNull sourceUnfoldr-        , benchFold "unfoldrM"      toNull sourceUnfoldrM-        ]-      , bgroup "elimination"-        [ benchFold "toNull"   toNull   sourceUnfoldrM-        , benchFold "uncons"   uncons   sourceUnfoldrM-        ]-      ]-    ]--main :: IO ()-main = defaultMain [o_1_space]
− benchmark/Streamly/Benchmark/Data/Stream/ToStreamK.hs 
@@ -1,938 +0,0 @@--- |--- Module      : Streamly.Benchmark.Data.StreamK--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -Wno-orphans #-}--#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif--module Main (main) where---- import Control.Applicative (liftA2)--- import Control.Monad (when)--- import Data.Maybe (isJust)--- import System.Random (randomRIO)-import Prelude hiding-    ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate-    , repeat, replicate-    )--import qualified Prelude as P--- import qualified Data.List as List--import qualified Streamly.Internal.Data.StreamK as S-import qualified Streamly.Internal.Data.Stream as D-import qualified Streamly.Internal.Data.Fold as Fold--import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)--import Streamly.Benchmark.Common--#ifdef INSPECTION-import Test.Inspection-#endif------------------------------------------------------------------------------------ Stream generation and elimination----------------------------------------------------------------------------------type Stream m a = S.Stream m a--{-# INLINE unfoldrD #-}-unfoldrD :: Monad m => Int -> Int -> Stream m Int-unfoldrD streamLen n = D.toStreamK (D.unfoldr step n)-    where-    step cnt =-        if cnt > n + streamLen-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE unfoldrMD #-}-unfoldrMD :: Monad m => Int -> Int -> Stream m Int-unfoldrMD streamLen n = D.toStreamK (D.unfoldrM step n)-    where-    step cnt =-        if cnt > n + streamLen-        then return Nothing-        else return (Just (cnt, cnt + 1))--{--{-# INLINE unfoldrK #-}-unfoldrK :: Int -> Int -> Stream m Int-unfoldrK streamLen n = S.unfoldr step n-    where-    step cnt =-        if cnt > n + streamLen-        then Nothing-        else Just (cnt, cnt + 1)--}--{-# INLINE unfoldrMK #-}-unfoldrMK :: Monad m => Int -> Int -> Stream m Int-unfoldrMK streamLen n = S.unfoldrMWith S.consM step n-    where-    step cnt =-        if cnt > n + streamLen-        then return Nothing-        else return (Just (cnt, cnt + 1))--{-# INLINE repeat #-}-repeat :: Monad m => Int -> Int -> Stream m Int-repeat streamLen = S.take streamLen . D.toStreamK . D.repeat--{-# INLINE repeatM #-}-repeatM :: Monad m => Int -> Int -> Stream m Int-repeatM streamLen = S.take streamLen . D.toStreamK . D.repeatM . return--{-# INLINE replicate #-}-replicate :: Monad m => Int -> Int -> Stream m Int-replicate x y = D.toStreamK $ D.replicate x y--{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> Int -> Stream m Int-replicateM streamLen = D.toStreamK . D.replicateM streamLen . return--{-# INLINE iterate #-}-iterate :: Monad m => Int -> Int -> Stream m Int-iterate streamLen = S.take streamLen . D.toStreamK . D.iterate (+1)--{-# INLINE iterateM #-}-iterateM :: Monad m => Int -> Int -> Stream m Int-iterateM streamLen = S.take streamLen . D.toStreamK . D.iterateM (return . (+1)) . return--{-# INLINE fromFoldable #-}-fromFoldable :: Int -> Int -> Stream m Int-fromFoldable streamLen n = S.fromFoldable [n..n+streamLen]--{-# INLINE fromFoldableM #-}-fromFoldableM :: Monad m => Int -> Int -> Stream m Int-fromFoldableM streamLen n =-    Prelude.foldr (S.consM . return) S.nil [n .. n + streamLen]--{--{-# INLINABLE concatMapFoldableWith #-}-concatMapFoldableWith :: Foldable f-    => (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> f a-    -> Stream m b-concatMapFoldableWith f g = Prelude.foldr (f . g) S.nil--}--{-# INLINE concatMapFoldableSerial #-}-concatMapFoldableSerial :: Monad m => Int -> Int -> Stream m Int-concatMapFoldableSerial streamLen n =-    D.toStreamK $ D.concatMap D.fromPure $ D.fromStreamK $ S.fromList [n..n+streamLen]--{-# INLINE concatMapFoldableSerialM #-}-concatMapFoldableSerialM :: Monad m => Int -> Int -> Stream m Int-concatMapFoldableSerialM streamLen n =-    -- concatMapFoldableWith S.serial (S.fromEffect . return) [n..n+streamLen]-    D.toStreamK $ D.concatMap (D.fromEffect . return) $ D.fromStreamK $ S.fromList [n..n+streamLen]------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE drainD #-}-drainD :: Monad m => Stream m a -> m ()-drainD = D.drain . D.fromStreamK--{-# INLINE drain #-}-drain :: Monad m => Stream m a -> m ()-drain = S.drain--{-# INLINE mapM_ #-}-mapM_ :: Monad m => Stream m a -> m ()-mapM_ s = D.mapM_ (\_ -> return ()) $ D.fromStreamK s--{--{-# INLINE uncons #-}-uncons :: Monad m => Stream m Int -> m ()-uncons s = do-    r <- D.uncons $ D.fromStreamK s-    case r of-        Nothing -> return ()-        Just (_, t) -> uncons (D.toStreamK t)--{-# INLINE init #-}-init :: Monad m => Stream m a -> m ()-init s = do-    t <- S.init s-    P.mapM_ S.drain t--{-# INLINE tail #-}-tail :: Monad m => Stream m a -> m ()-tail s = S.tail s >>= P.mapM_ tail--{-# INLINE nullTail #-}-nullTail :: Monad m => Stream m Int -> m ()-nullTail s = do-    r <- S.null s-    when (not r) $ S.tail s >>= P.mapM_ nullTail--{-# INLINE headTail #-}-headTail :: Monad m => Stream m Int -> m ()-headTail s = do-    h <- S.head s-    when (isJust h) $ S.tail s >>= P.mapM_ headTail--}--{-# INLINE toList #-}-toList :: Monad m => Stream m Int -> m [Int]-toList = D.fold Fold.toList . D.fromStreamK--{-# INLINE foldl' #-}-foldl' :: Monad m => Stream m Int -> m Int-foldl' = D.fold (Fold.foldl' (+) 0) . D.fromStreamK--{-# INLINE last #-}-last :: Monad m => Stream m Int -> m (Maybe Int)-last = D.fold Fold.latest . D.fromStreamK------------------------------------------------------------------------------------ Transformation----------------------------------------------------------------------------------{-# INLINE composeN #-}-composeN-    :: Monad m-    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()-composeN n f =-    case n of-        1 -> drain . f-        2 -> drain . f . f-        3 -> drain . f . f . f-        4 -> drain . f . f . f . f-        _ -> undefined--{-# INLINE scanl' #-}-scanl' :: Monad m => Int -> Stream m Int -> m ()-scanl' n =-    composeN n (D.toStreamK . D.scan (Fold.foldl' (+) 0) . D.fromStreamK)--{-# INLINE map #-}-map :: Monad m => Int -> Stream m Int -> m ()-map n = composeN n (D.toStreamK . D.map (+ 1) . D.fromStreamK)--{--{-# INLINE fmapK #-}-fmapK :: Monad m => Int -> Stream m Int -> m ()-fmapK n = composeN n $ P.fmap (+ 1)--}--{-# INLINE mapM #-}-mapM :: Monad m => Int -> Stream m Int -> m ()-mapM n = composeN n (D.toStreamK . D.mapM return . D.fromStreamK)--{--{-# INLINE mapMSerial #-}-mapMSerial :: S.MonadAsync m => Int -> Stream m Int -> m ()-mapMSerial n = composeN n $ S.mapMSerial return--}--{-# INLINE filterEven #-}-filterEven :: Monad m => Int -> Stream m Int -> m ()-filterEven n = composeN n (D.toStreamK . D.filter even . D.fromStreamK)--{--{-# INLINE filterAllOut #-}-filterAllOut :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllOut streamLen n = composeN n $ S.filter (> streamLen)--{-# INLINE filterAllIn #-}-filterAllIn :: Monad m => Int -> Int -> Stream m Int -> m ()-filterAllIn streamLen n = composeN n $ S.filter (<= streamLen)--{-# INLINE _takeOne #-}-_takeOne :: Monad m => Int -> Stream m Int -> m ()-_takeOne n = composeN n $ S.take 1--{-# INLINE takeAll #-}-takeAll :: Monad m => Int -> Int -> Stream m Int -> m ()-takeAll streamLen n = composeN n $ S.take streamLen--{-# INLINE takeWhileTrue #-}-takeWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-takeWhileTrue streamLen n = composeN n $ S.takeWhile (<= streamLen)--{-# INLINE dropOne #-}-dropOne :: Monad m => Int -> Stream m Int -> m ()-dropOne n = composeN n $ S.drop 1--{-# INLINE dropAll #-}-dropAll :: Monad m => Int -> Int -> Stream m Int -> m ()-dropAll streamLen n = composeN n $ S.drop streamLen--{-# INLINE dropWhileTrue #-}-dropWhileTrue :: Monad m => Int -> Int -> Stream m Int -> m ()-dropWhileTrue streamLen n = composeN n $ S.dropWhile (<= streamLen)--{-# INLINE dropWhileFalse #-}-dropWhileFalse :: Monad m => Int -> Stream m Int -> m ()-dropWhileFalse n = composeN n $ S.dropWhile (<= 1)--}--{--{-# INLINE foldrS #-}-foldrS :: Monad m => Int -> Stream m Int -> m ()-foldrS n = composeN n $ S.foldrS S.cons S.nil--{-# INLINE foldlS #-}-foldlS :: Monad m => Int -> Stream m Int -> m ()-foldlS n = composeN n $ S.foldlS (flip S.cons) S.nil--}--{--{-# INLINE intersperse #-}-intersperse :: S.MonadAsync m => Int -> Int -> Stream m Int -> m ()-intersperse streamLen n = composeN n $ S.intersperse streamLen--}------------------------------------------------------------------------------------ Iteration----------------------------------------------------------------------------------{--{-# INLINE iterateSource #-}-iterateSource-    :: S.MonadAsync m-    => Int -> (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int-iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)-    where-        f (0 :: Int) m = g m-        f x m = g (f (x P.- 1) m)---- this is quadratic-{-# INLINE iterateScan #-}-iterateScan :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateScan iterStreamLen maxIters =-    iterateSource iterStreamLen (S.scanl' (+) 0) (maxIters `div` 10)---- this is quadratic-{-# INLINE iterateDropWhileFalse #-}-iterateDropWhileFalse :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileFalse streamLen iterStreamLen maxIters =-    iterateSource iterStreamLen (S.dropWhile (> streamLen)) (maxIters `div` 10)--{-# INLINE iterateMapM #-}-iterateMapM :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateMapM iterStreamLen =-    iterateSource iterStreamLen (S.mapMWith S.consM return)--{-# INLINE iterateFilterEven #-}-iterateFilterEven :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateFilterEven iterStreamLen = iterateSource iterStreamLen (S.filter even)--{-# INLINE iterateTakeAll #-}-iterateTakeAll :: S.MonadAsync m => Int -> Int -> Int -> Int -> Stream m Int-iterateTakeAll streamLen iterStreamLen =-    iterateSource iterStreamLen (S.take streamLen)--{-# INLINE iterateDropOne #-}-iterateDropOne :: S.MonadAsync m => Int -> Int -> Int -> Stream m Int-iterateDropOne iterStreamLen = iterateSource iterStreamLen (S.drop 1)--{-# INLINE iterateDropWhileTrue #-}-iterateDropWhileTrue :: S.MonadAsync m =>-    Int -> Int -> Int -> Int -> Stream m Int-iterateDropWhileTrue streamLen iterStreamLen =-    iterateSource iterStreamLen (S.dropWhile (<= streamLen))--}------------------------------------------------------------------------------------ Zipping----------------------------------------------------------------------------------{--{-# INLINE zipWith #-}-zipWith :: Monad m => Stream m Int -> m ()-zipWith src = drain $ S.zipWith (,) src src--{-# INLINE zipWithM #-}-zipWithM :: Monad m => Stream m Int -> m ()-zipWithM src = drain $ S.zipWithM (curry return) src src--{-# INLINE sortByK #-}-sortByK :: (a -> a -> Ordering) -> Stream m a -> Stream m a-sortByK f = S.concatPairsWith (S.mergeBy f) S.fromPure--{-# INLINE sortBy #-}-sortBy :: Monad m => Stream m Int -> m ()-sortBy = drain . sortByK compare------------------------------------------------------------------------------------ Mixed Composition----------------------------------------------------------------------------------{-# INLINE scanMap #-}-scanMap :: Monad m => Int -> Stream m Int -> m ()-scanMap n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0--{-# INLINE dropMap #-}-dropMap :: Monad m => Int -> Stream m Int -> m ()-dropMap n = composeN n $ S.map (subtract 1) . S.drop 1--{-# INLINE dropScan #-}-dropScan :: Monad m => Int -> Stream m Int -> m ()-dropScan n = composeN n $ S.scanl' (+) 0 . S.drop 1--{-# INLINE takeDrop #-}-takeDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-takeDrop streamLen n = composeN n $ S.drop 1 . S.take streamLen--{-# INLINE takeScan #-}-takeScan :: Monad m => Int -> Int -> Stream m Int -> m ()-takeScan streamLen n = composeN n $ S.scanl' (+) 0 . S.take streamLen--{-# INLINE takeMap #-}-takeMap :: Monad m => Int -> Int -> Stream m Int -> m ()-takeMap streamLen n = composeN n $ S.map (subtract 1) . S.take streamLen--{-# INLINE filterDrop #-}-filterDrop :: Monad m => Int -> Int -> Stream m Int -> m ()-filterDrop streamLen n = composeN n $ S.drop 1 . S.filter (<= streamLen)--{-# INLINE filterTake #-}-filterTake :: Monad m => Int -> Int -> Stream m Int -> m ()-filterTake streamLen n = composeN n $ S.take streamLen . S.filter (<= streamLen)--{-# INLINE filterScan #-}-filterScan :: Monad m => Int -> Stream m Int -> m ()-filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)--{-# INLINE filterMap #-}-filterMap :: Monad m => Int -> Int -> Stream m Int -> m ()-filterMap streamLen n = composeN n $ S.map (subtract 1) . S.filter (<= streamLen)--}------------------------------------------------------------------------------------ ConcatMap------------------------------------------------------------------------------------ concatMap unfoldrM/unfoldrM--{-# INLINE concatMap #-}-concatMap :: Int -> Int -> Int -> IO ()-concatMap outer inner n =-    S.drain $ D.toStreamK $ D.concatMap-        (\_ -> D.fromStreamK $ unfoldrMK inner n)-        (D.fromStreamK $ unfoldrMK outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMap-#endif---- concatMap unfoldr/unfoldr--{--{-# INLINE concatMapPure #-}-concatMapPure :: Int -> Int -> Int -> IO ()-concatMapPure outer inner n =-    S.drain $ S.concatMap-        (\_ -> unfoldr inner n)-        (unfoldr outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapPure-#endif---- concatMap replicate/unfoldrM--{-# INLINE concatMapRepl #-}-concatMapRepl :: Int -> Int -> Int -> IO ()-concatMapRepl outer inner n =-    S.drain $ S.concatMap (S.replicate inner) (unfoldrM outer n)--#ifdef INSPECTION-inspect $ hasNoTypeClasses 'concatMapRepl-#endif---- concatMapWith--{-# INLINE sourceConcatMapId #-}-sourceConcatMapId :: Monad m-    => Int -> Int -> Stream m (Stream m Int)-sourceConcatMapId val n =-    S.fromFoldable $ fmap (S.fromEffect . return) [n..n+val]--{-# INLINE concatMapBySerial #-}-concatMapBySerial :: Int -> Int -> Int -> IO ()-concatMapBySerial outer inner n =-    S.drain $ S.concatMapWith S.serial-        (unfoldrM inner)-        (unfoldrM outer n)--}--{------------------------------------------------------------------------------------ Nested Composition----------------------------------------------------------------------------------instance Monad m => Applicative (S.Stream m) where-    {-# INLINE pure #-}-    pure = S.fromPure--    {-# INLINE (<*>) #-}-    (<*>) = S.crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = S.crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = S.crossApplyFst---- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,--- the monad instance of StreamD is slower than StreamK after foldr/build--- fusion.-instance Monad m => Monad (S.Stream m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip S.concatMap--{-# INLINE drainApplicative #-}-drainApplicative :: Monad m => Stream m Int -> m ()-drainApplicative s = drain $ do-    (+) <$> s <*> s--{-# INLINE drainMonad #-}-drainMonad :: Monad m => Stream m Int -> m ()-drainMonad s = drain $ do-    x <- s-    y <- s-    return $ x + y--{-# INLINE drainMonad3 #-}-drainMonad3 :: Monad m => Stream m Int -> m ()-drainMonad3 s = drain $ do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutMonad #-}-filterAllOutMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllOutMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else S.nil--{-# INLINE filterAllInMonad #-}-filterAllInMonad-    :: Monad m-    => Stream m Int -> m ()-filterAllInMonad str = drain $ do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else S.nil------------------------------------------------------------------------------------ Nested Composition Pure lists------------------------------------------------------------------------------------ There are several list benchmarks here for comparison with lists. It is easy--- and convenient to see the comparisons when they are here, otherwise we'll--- have to add a separate module for list benchmarks with the same names and--- then add a comparison in bench.sh.--{-# INLINE unfoldrList #-}-unfoldrList :: Int -> Int -> [Int]-unfoldrList maxval n = List.unfoldr step n-    where-    step cnt =-        if cnt > n + maxval-        then Nothing-        else Just (cnt, cnt + 1)--{-# INLINE toNullApNestedList #-}-toNullApNestedList :: [Int] -> [Int]-toNullApNestedList s = (+) <$> s <*> s--{-# INLINE toNullNestedList #-}-toNullNestedList :: [Int] -> [Int]-toNullNestedList s = do-    x <- s-    y <- s-    return $ x + y--{-# INLINE toNullNestedList3 #-}-toNullNestedList3 :: [Int] -> [Int]-toNullNestedList3 s = do-    x <- s-    y <- s-    z <- s-    return $ x + y + z--{-# INLINE filterAllOutNestedList #-}-filterAllOutNestedList :: [Int] -> [Int]-filterAllOutNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s < 0-    then return s-    else []--{-# INLINE filterAllInNestedList #-}-filterAllInNestedList :: [Int] -> [Int]-filterAllInNestedList str = do-    x <- str-    y <- str-    let s = x + y-    if s > 0-    then return s-    else []-        -}------------------------------------------------------------------------------------ Benchmarks----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Stream.ToStreamK"---- Generation of StreamK using StreamD generation functions and eleminating--- using StreamK drain.-o_1_space_generation :: Int -> Benchmark-o_1_space_generation streamLen =-    bgroup "generation"-        [ benchFold "unfoldr" drain (unfoldrD streamLen)-        , benchFold "unfoldrM" drain (unfoldrMD streamLen)-        , benchFold "repeat" drain (repeat streamLen)-        , benchFold "repeatM" drain (repeatM streamLen)-        , benchFold "replicate" drain (replicate streamLen)-        , benchFold "replicateM" drain (replicateM streamLen)-        , benchFold "iterate" drain (iterate streamLen)-        , benchFold "iterateM" drain (iterateM streamLen)--        , benchFold "fromFoldable"  drain (fromFoldable streamLen)-        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)--        -- appends-        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)-        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)-        ]---- Generating using StreamK and eliminating using StreamD folds.-o_1_space_elimination :: Int -> Benchmark-o_1_space_elimination streamLen =-    bgroup "elimination"-        [ benchFold "toNull"   drainD   (unfoldrMK streamLen)-        , benchFold "mapM_"    mapM_    (unfoldrMK streamLen)-        -- , benchFold "uncons"   uncons   (unfoldrMK streamLen)-        -- , benchFold "init"   init     (unfoldrM streamLen)-        , benchFold "foldl'" foldl'    (unfoldrMK streamLen)-        , benchFold "last"   last     (unfoldrMK streamLen)-        ]--{--o_1_space_nested :: Int -> Benchmark-o_1_space_nested streamLen =-    bgroup "nested"-        [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)-        , benchFold "drainMonad"   drainMonad   (unfoldrM streamLen2)-        , benchFold "drainMonad3"  drainMonad3  (unfoldrM streamLen3)-        , benchFold "filterAllInMonad"  filterAllInMonad  (unfoldrM streamLen2)-        , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)-        , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)-        , benchFold "drainMonad (pure)"   drainMonad   (unfoldr streamLen2)-        , benchFold "drainMonad3 (pure)"  drainMonad3  (unfoldr streamLen3)-        , benchFold "filterAllInMonad (pure)"  filterAllInMonad  (unfoldr streamLen2)-        , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--}---- Generate using StreamK and transform using StreamD transformation functions--- and then drain using StreamK.-o_1_space_transformation :: Int -> Benchmark-o_1_space_transformation streamLen =-    bgroup "transformation"-        [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)-          benchFold "scanl'"   (scanl' 1) (unfoldrMK streamLen)-        , benchFold "map"    (map  1) (unfoldrMK streamLen)-        -- , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)-        , benchFold "mapM"   (mapM 1) (unfoldrMK streamLen)-        -- , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)-        ]--o_1_space_transformationX4 :: Int -> Benchmark-o_1_space_transformationX4 streamLen =-    bgroup "transformationX4"-        [ benchFold "scanl'"   (scanl' 4) (unfoldrMK streamLen)-        , benchFold "map"    (map  4) (unfoldrMK streamLen)-        -- , benchFold "fmap"   (fmapK 4) (unfoldrMK streamLen)-        , benchFold "mapM"   (mapM 4) (unfoldrMK streamLen)-        -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)-        -- XXX this is horribly slow-        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)-        ]---- Generate using K, fold using K, concat using D.concatMap-o_1_space_concat :: Int -> Benchmark-o_1_space_concat streamLen =-    bgroup "concat"-        [ {- benchIOSrc1 "concatMapPure (n of 1)"-            (concatMapPure streamLen 1)-        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"-            (concatMapPure streamLen2 streamLen2)-        , benchIOSrc1 "concatMapPure (1 of n)"-            (concatMapPure 1 streamLen)-            -}--          benchIOSrc1 "concatMap (n of 1)"-            (concatMap streamLen 1)-        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"-            (concatMap streamLen2 streamLen2)-        , benchIOSrc1 "concatMap (1 of n)"-            (concatMap 1 streamLen)--{--        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"-            (concatMapRepl streamLen2 streamLen2)--        -- This is for comparison with concatMapFoldableWith-        , benchIOSrc1 "concatMapWithId (n of 1) (fromFoldable)"-            (S.drain-                . S.concatMapWith S.serial id-                . sourceConcatMapId streamLen)--        , benchIOSrc1 "concatMapBy serial (n of 1)"-            (concatMapBySerial streamLen 1)-        , benchIOSrc1 "concatMapBy serial (sqrt n of sqrt n)"-            (concatMapBySerial streamLen2 streamLen2)-        , benchIOSrc1 "concatMapBy serial (1 of n)"-            (concatMapBySerial 1 streamLen)-        , benchFold "sortBy" sortBy (unfoldrM streamLen)-        -}-        ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop--o_1_space_filtering :: Int -> Benchmark-o_1_space_filtering streamLen =-    bgroup "filtering"-        [ benchFold "filter-even"     (filterEven     1) (unfoldrMK streamLen)-        {--        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)-        -}-        ]--o_1_space_filteringX4 :: Int -> Benchmark-o_1_space_filteringX4 streamLen =-    bgroup "filteringX4"-        [ benchFold "filter-even"     (filterEven     4) (unfoldrMK streamLen)-        {--        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)-        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)-        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)-        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)-        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)-        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)-        -}-        ]--{--o_1_space_zipping :: Int -> Benchmark-o_1_space_zipping streamLen =-    bgroup "zipping"-        [ benchFold "zipWith" zipWith (unfoldrM streamLen)-        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)-        ]--o_1_space_mixed :: Int -> Benchmark-o_1_space_mixed streamLen =-    bgroup "mixed"-        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)-        ]--o_1_space_mixedX2 :: Int -> Benchmark-o_1_space_mixedX2 streamLen =-    bgroup "mixedX2"-        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)-        ]--o_1_space_mixedX4 :: Int -> Benchmark-o_1_space_mixedX4 streamLen =-    bgroup "mixedX4"-        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)-        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)-        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)-        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)-        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)-        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)-        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)-        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)-        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)-        ]-        -}--{--o_1_space_list :: Int -> Benchmark-o_1_space_list streamLen =-    bgroup "list"-      [ bgroup "elimination"-        [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)-        ]-      , bgroup "nested"-        [ benchList "toNullAp" toNullApNestedList (unfoldrList streamLen2)-        , benchList "toNull"   toNullNestedList (unfoldrList streamLen2)-        , benchList "toNull3"  toNullNestedList3 (unfoldrList streamLen3)-        , benchList "filterAllIn"  filterAllInNestedList (unfoldrList streamLen2)-        , benchList "filterAllOut"  filterAllOutNestedList (unfoldrList streamLen2)-        ]-      ]-    where--    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop--}--o_1_space :: Int -> Benchmark-o_1_space streamLen =-    bgroup (o_1_space_prefix moduleName)-      [ o_1_space_generation streamLen-      , o_1_space_elimination streamLen-      -- , o_1_space_nested streamLen-      , o_1_space_transformation streamLen-      , o_1_space_transformationX4 streamLen-      , o_1_space_concat streamLen-      , o_1_space_filtering streamLen-      , o_1_space_filteringX4 streamLen-      -- , o_1_space_zipping streamLen-      -- , o_1_space_mixed streamLen-      -- , o_1_space_mixedX2 streamLen-      -- , o_1_space_mixedX4 streamLen-      -- , o_1_space_list streamLen-      ]--{--o_n_heap :: Int -> Benchmark-o_n_heap streamLen =-    bgroup (o_n_heap_prefix moduleName)-      [ bgroup "transformation"-        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)-        ]-      ]--{-# INLINE benchK #-}-benchK :: P.String -> (Int -> Stream P.IO Int) -> Benchmark-benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f--o_n_stack :: Int -> Int -> Int -> Benchmark-o_n_stack streamLen iterStreamLen maxIters =-    bgroup (o_n_stack_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "tail"   tail     (unfoldrM streamLen)-        , benchFold "nullTail" nullTail (unfoldrM streamLen)-        , benchFold "headTail" headTail (unfoldrM streamLen)-        ]-      , bgroup "transformation"-        [-          -- XXX why do these need so much stack-          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)-        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)-        ]-      , bgroup "transformationX4"-        [-          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)-        ]-      , bgroup "iterated"-        [ benchK "mapM"                 (iterateMapM iterStreamLen maxIters)-        , benchK "scan(1/10)"           (iterateScan iterStreamLen maxIters)-        , benchK "filterEven"           (iterateFilterEven iterStreamLen maxIters)-        , benchK "takeAll"              (iterateTakeAll streamLen iterStreamLen maxIters)-        , benchK "dropOne"              (iterateDropOne iterStreamLen maxIters)-        , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)-        , benchK "dropWhileTrue"        (iterateDropWhileTrue streamLen iterStreamLen maxIters)-        ]-      ]-    where-    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop-    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop--}--o_n_space :: Int -> Benchmark-o_n_space streamLen =-    bgroup (o_n_space_prefix moduleName)-      [ bgroup "elimination"-        [ benchFold "toList" toList   (unfoldrMK streamLen)-        ]-      ]--{--{-# INLINE benchList #-}-benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark-benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f--}--main :: IO ()-main =-    defaultMain-        [ o_1_space streamLen-        -- , o_n_stack streamLen iterStreamLen maxIters-        -- , o_n_heap streamLen-        , o_n_space streamLen-        ]--    where--    streamLen = 100000-    -- maxIters = 10000-    -- iterStreamLen = 10
benchmark/Streamly/Benchmark/Data/Stream/Transform.hs view
@@ -12,7 +12,6 @@  {-# OPTIONS_GHC -Wno-orphans #-} #ifdef USE_PRELUDE-{-# OPTIONS_GHC -Wno-deprecations #-} #endif  #ifdef __HADDOCK_VERSION__@@ -31,6 +30,7 @@ import System.Random (randomRIO)  import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Scanl as Scanl  import qualified Stream.Common as Common import qualified Streamly.Internal.Data.Unfold as Unfold@@ -40,6 +40,7 @@ import Data.Functor.Identity (Identity(..)) import qualified Prelude import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl import qualified Streamly.Internal.Data.Stream.IsStream as Stream import Streamly.Internal.Data.Time.Units #else@@ -48,15 +49,7 @@ #ifndef USE_STREAMLY_CORE import qualified Streamly.Internal.Data.Stream.Prelude as Stream #endif-#ifdef USE_STREAMK-import Control.DeepSeq (NFData(..))-import Data.Functor.Identity (Identity(..))-import qualified Prelude-import qualified Streamly.Internal.Data.Fold as Fold-import Streamly.Internal.Data.StreamK (StreamK)-import qualified Streamly.Internal.Data.StreamK as StreamK #endif-#endif  import Test.Tasty.Bench import Stream.Common hiding (scanl')@@ -76,54 +69,6 @@ -------------------------------------------------------------------------------  ---------------------------------------------------------------------------------- Traversable Instance----------------------------------------------------------------------------------#ifdef USE_STREAMK-{-# INLINE traversableTraverse #-}-traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)-traversableTraverse = traverse return--{-# INLINE traversableSequenceA #-}-traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)-traversableSequenceA = sequenceA . Prelude.fmap return--{-# INLINE traversableMapM #-}-traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)-traversableMapM = Prelude.mapM return--{-# INLINE traversableSequence #-}-traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)-traversableSequence = Prelude.sequence . Prelude.fmap return--{-# INLINE benchPureSinkIO #-}-benchPureSinkIO-    :: NFData b-    => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark-benchPureSinkIO value name f =-    bench name-        $ nfIO $ randomRIO (1, 1) >>= f . fromStream . sourceUnfoldr value--instance NFData a => NFData (StreamK Identity a) where-    {-# INLINE rnf #-}-    rnf xs =-        runIdentity-            $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (toStream xs)--o_n_space_traversable :: Int -> [Benchmark]-o_n_space_traversable value =-    -- Buffering operations using heap proportional to number of elements.-    [ bgroup "traversable"-        -- Traversable instance-        [ benchPureSinkIO value "traverse" traversableTraverse-        , benchPureSinkIO value "sequenceA" traversableSequenceA-        , benchPureSinkIO value "mapM" traversableMapM-        , benchPureSinkIO value "sequence" traversableSequence-        ]-    ]-#endif--------------------------------------------------------------------------------- -- maps and scans ------------------------------------------------------------------------------- @@ -145,10 +90,16 @@ scanl1M' n = composeN n $ Stream.scanl1M' (\b a -> return $ b + a) #endif +#ifndef USE_PRELUDE {-# INLINE scan #-} scan :: MonadIO m => Int -> Stream m Int -> m ()-scan n = composeN n $ Stream.scan FL.sum+scan n = composeN n $ Stream.scanl Scanl.sum +{-# INLINE postscan #-}+postscan :: MonadIO m => Int -> Stream m Int -> m ()+postscan n = composeN n $ Stream.postscanl Scanl.sum+#endif+ #ifdef USE_PRELUDE {-# INLINE postscanl' #-} postscanl' :: MonadIO m => Int -> Stream m Int -> m ()@@ -159,10 +110,6 @@ postscanlM' n = composeN n $ Stream.postscanlM' (\b a -> return $ b + a) (return 0) #endif -{-# INLINE postscan #-}-postscan :: MonadIO m => Int -> Stream m Int -> m ()-postscan n = composeN n $ Stream.postscan FL.sum- {-# INLINE sequence #-} sequence :: MonadAsync m => Stream m (m Int) -> m () sequence = Common.drain . Stream.sequence@@ -186,22 +133,6 @@ timestamped = Stream.drain . Stream.timestamped #endif -#ifdef USE_STREAMK-{-# INLINE foldrS #-}-foldrS :: MonadIO m => Int -> Stream m Int -> m ()-foldrS n =-    composeN n (toStream . StreamK.foldrS StreamK.cons StreamK.nil . fromStream)--{-# INLINE foldrSMap #-}-foldrSMap :: MonadIO m => Int -> Stream m Int -> m ()-foldrSMap n =-    composeN n-        ( toStream-        . StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil-        . fromStream-        )-#endif- {- {-# INLINE foldrT #-} foldrT :: MonadIO m => Int -> Stream m Int -> m ()@@ -223,12 +154,6 @@     [ bgroup         "mapping"         [-#ifdef USE_STREAMK-        -- Right folds-          benchIOSink value "foldrS" (foldrS 1)-        , benchIOSink value "foldrSMap" (foldrSMap 1)-        ,-#endif         -- , benchIOSink value "foldrT" (foldrT 1)         -- , benchIOSink value "foldrTMap" (foldrTMap 1) @@ -250,8 +175,10 @@         , benchIOSink value "postscanl'" (postscanl' 1)         , benchIOSink value "postscanlM'" (postscanlM' 1) #endif+#ifndef USE_PRELUDE         , benchIOSink value "scan" (scan 1)         , benchIOSink value "postscan" (postscan 1)+#endif         ]     ] @@ -270,25 +197,39 @@         , benchIOSink value "postscanl'" (postscanl' 4)         , benchIOSink value "postscanlM'" (postscanlM' 4) #endif+#ifndef USE_PRELUDE+        , benchIOSink value "scan" (scan 4)+        , benchIOSink value "postscan" (postscan 4)+{-+        -- XXX this is horribly slow+        , let value16 = round (fromIntegral value**(1/16::Double))+           benchFold "concatMap" (concatMap 4) (sourceUnfoldrMN value16)+-}+#endif         ]     ] +#ifndef USE_PRELUDE {-# INLINE sieveScan #-} sieveScan :: Monad m => Stream m Int -> Stream m Int sieveScan =       Stream.mapMaybe snd-    . Stream.scan (FL.foldlM' (\(primes, _) n -> do+    . Stream.scanl (Scanl.mkScanlM (\(primes, _) n -> do             return $                 let ps = takeWhile (\p -> p * p <= n) primes                  in if all (\p -> n `mod` p /= 0) ps                     then (primes ++ [n], Just n)                     else (primes, Nothing)) (return ([2], Just 2)))+#endif  o_n_space_mapping :: Int -> [Benchmark] o_n_space_mapping value =     [ bgroup "mapping"-        [ benchIO "naive prime sieve"+        [+#ifndef USE_PRELUDE+          benchIO "naive prime sieve"             (\n -> Stream.fold FL.sum $ sieveScan $ Stream.enumerateFromTo 2 (value + n))+#endif         ]     ] @@ -317,25 +258,14 @@     f (0 :: Int) x = x     f i x = f (i - 1) (g i x) -#ifdef USE_STREAMK -- Iterate a transformation over a singleton stream {-# INLINE iterateSingleton #-} iterateSingleton :: Applicative m =>-       (Int -> StreamK m Int -> StreamK m Int)-    -> Int-    -> Int-    -> Stream m Int-iterateSingleton g count n = toStream $ iterateN g (StreamK.fromPure n) count-#else--- Iterate a transformation over a singleton stream-{-# INLINE iterateSingleton #-}-iterateSingleton :: Applicative m =>        (Int -> Stream m Int -> Stream m Int)     -> Int     -> Int     -> Stream m Int iterateSingleton g count n = iterateN g (Stream.fromPure n) count-#endif  {- -- XXX need to check why this is slower than the explicit recursion above, even@@ -601,12 +531,12 @@ {-# INLINE interposeSuffix #-} interposeSuffix :: Monad m => Int -> Int -> Stream m Int -> m () interposeSuffix value n =-    composeN n $ Stream.interposeSuffix (value + 1) Unfold.identity+    composeN n $ Stream.unfoldEachSepBy (value + 1) Unfold.identity  {-# INLINE intercalateSuffix #-} intercalateSuffix :: Monad m => Int -> Int -> Stream m Int -> m () intercalateSuffix value n =-    composeN n $ Stream.intercalateSuffix Unfold.identity (value + 1)+    composeN n $ Stream.unfoldEachSepBySeq (value + 1) Unfold.identity  o_1_space_inserting :: Int -> [Benchmark] o_1_space_inserting value =@@ -616,6 +546,7 @@         , benchIOSink value "insertBy" (insertBy value 1)         , benchIOSink value "interposeSuffix" (interposeSuffix value 1)         , benchIOSink value "intercalateSuffix" (intercalateSuffix value 1)+        , benchIOSinkPureSrc value "interspersePure" (intersperse value 1)         ]     ] @@ -677,10 +608,6 @@             ]         , bgroup (o_n_space_prefix moduleName) $ Prelude.concat             [-#ifdef USE_STREAMK-              o_n_space_traversable size-            ,-#endif               o_n_space_mapping size             , o_n_space_iterated size             ]
+ benchmark/Streamly/Benchmark/Data/StreamK.hs view
@@ -0,0 +1,980 @@+-- |+-- Module      : Streamly.Benchmark.Data.StreamK+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Main (main) where++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Monad (when)+import Data.Maybe (isJust)+import Streamly.Internal.Data.StreamK (StreamK)+import System.Random (randomRIO)+import Test.Tasty.Bench (bench, nfIO, bgroup, Benchmark)++import qualified Data.List as List+import qualified Prelude as P+import qualified Streamly.Internal.Data.StreamK as StreamK++import Prelude hiding+    ( Foldable(..), tail, mapM_, last, map, mapM, concatMap, zipWith, init+    , iterate, repeat, replicate+    )+import Streamly.Benchmark.Common+#ifdef INSPECTION+import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldr #-}+unfoldr :: Int -> Int -> StreamK m Int+unfoldr streamLen n = StreamK.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => Int -> Int -> StreamK m Int+unfoldrM streamLen n = StreamK.unfoldrMWith StreamK.consM step n+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE repeat #-}+repeat :: Int -> Int -> StreamK m Int+repeat streamLen = StreamK.take streamLen . StreamK.repeat++{-# INLINE repeatM #-}+repeatM :: Monad m => Int -> Int -> StreamK m Int+repeatM streamLen = StreamK.take streamLen . StreamK.repeatM . return++{-# INLINE replicate #-}+replicate :: Int -> Int -> StreamK m Int+replicate = StreamK.replicate++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> Int -> StreamK m Int+replicateM streamLen = StreamK.replicateMWith StreamK.consM streamLen . return++{-# INLINE iterate #-}+iterate :: Int -> Int -> StreamK m Int+iterate streamLen = StreamK.take streamLen . StreamK.iterate (+1)++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Int -> StreamK m Int+iterateM streamLen = StreamK.take streamLen . StreamK.iterateM (return . (+1)) . return++{-# INLINE fromFoldable #-}+fromFoldable :: Int -> Int -> StreamK m Int+fromFoldable streamLen n = StreamK.fromFoldable [n..n+streamLen]++{- HLINT ignore "Fuse foldr/fmap" -}+{-# INLINE fromFoldableM #-}+fromFoldableM :: Monad m => Int -> Int -> StreamK m Int+fromFoldableM streamLen n =+    List.foldr StreamK.consM StreamK.nil (Prelude.fmap return [n..n+streamLen])++{-# INLINABLE concatMapFoldableWith #-}+concatMapFoldableWith :: P.Foldable f+    => (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> f a+    -> StreamK m b+concatMapFoldableWith f g = P.foldr (f . g) StreamK.nil++{-# INLINE concatMapFoldableSerial #-}+concatMapFoldableSerial :: Int -> Int -> StreamK m Int+concatMapFoldableSerial streamLen n =+    concatMapFoldableWith StreamK.append StreamK.fromPure [n..n+streamLen]++{-# INLINE concatMapFoldableSerialM #-}+concatMapFoldableSerialM :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerialM streamLen n =+    concatMapFoldableWith StreamK.append (StreamK.fromEffect . return) [n..n+streamLen]++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE drain #-}+drain :: Monad m => StreamK m a -> m ()+drain = StreamK.drain++{-# INLINE mapM_ #-}+mapM_ :: Monad m => StreamK m a -> m ()+mapM_ = StreamK.mapM_ (\_ -> return ())++{-# INLINE uncons #-}+uncons :: Monad m => StreamK m Int -> m ()+uncons s = do+    r <- StreamK.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++{-# INLINE init #-}+init :: Monad m => StreamK m a -> m ()+init s = do+    t <- StreamK.init s+    P.mapM_ StreamK.drain t++{-# INLINE tail #-}+tail :: Monad m => StreamK m a -> m ()+tail s = StreamK.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+nullTail :: Monad m => StreamK m Int -> m ()+nullTail s = do+    r <- StreamK.null s+    when (not r) $ StreamK.tail s >>= P.mapM_ nullTail++{-# INLINE headTail #-}+headTail :: Monad m => StreamK m Int -> m ()+headTail s = do+    h <- StreamK.head s+    when (isJust h) $ StreamK.tail s >>= P.mapM_ headTail++{-# INLINE toList #-}+toList :: Monad m => StreamK m Int -> m [Int]+toList = StreamK.toList++{-# INLINE foldl' #-}+foldl' :: Monad m => StreamK m Int -> m Int+foldl' = StreamK.foldl' (+) 0++{-# INLINE foldlM' #-}+foldlM' :: Monad m => StreamK m Int -> m Int+foldlM' = StreamK.foldlM' (\b a -> return (b + a)) (return 0)++{-# INLINE last #-}+last :: Monad m => StreamK m Int -> m (Maybe Int)+last = StreamK.last++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (StreamK m Int -> StreamK m Int) -> StreamK m Int -> m ()+composeN n f =+    case n of+        1 -> drain . f+        2 -> drain . f . f+        3 -> drain . f . f . f+        4 -> drain . f . f . f . f+        _ -> undefined++{-# INLINE scanl' #-}+scanl' :: Monad m => Int -> StreamK m Int -> m ()+scanl' n = composeN n $ StreamK.scanl' (+) 0++{-# INLINE map #-}+map :: Monad m => Int -> StreamK m Int -> m ()+map n = composeN n $ StreamK.map (+ 1)++{-# INLINE fmapK #-}+fmapK :: Monad m => Int -> StreamK m Int -> m ()+fmapK n = composeN n $ P.fmap (+ 1)++{-# INLINE mapM #-}+mapM :: Monad m => Int -> StreamK m Int -> m ()+mapM n = composeN n $ StreamK.mapMWith StreamK.consM return++{-# INLINE mapMSerial #-}+mapMSerial :: Monad m => Int -> StreamK m Int -> m ()+mapMSerial n = composeN n $ StreamK.mapMSerial return++{-# INLINE filterEven #-}+filterEven :: Monad m => Int -> StreamK m Int -> m ()+filterEven n = composeN n $ StreamK.filter even++{-# INLINE filterAllOut #-}+filterAllOut :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllOut streamLen n = composeN n $ StreamK.filter (> streamLen)++{-# INLINE filterAllIn #-}+filterAllIn :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllIn streamLen n = composeN n $ StreamK.filter (<= streamLen)++{-# INLINE _takeOne #-}+_takeOne :: Monad m => Int -> StreamK m Int -> m ()+_takeOne n = composeN n $ StreamK.take 1++{-# INLINE takeAll #-}+takeAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeAll streamLen n = composeN n $ StreamK.take streamLen++{-# INLINE takeWhileTrue #-}+takeWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeWhileTrue streamLen n = composeN n $ StreamK.takeWhile (<= streamLen)++{-# INLINE dropOne #-}+dropOne :: Monad m => Int -> StreamK m Int -> m ()+dropOne n = composeN n $ StreamK.drop 1++{-# INLINE dropAll #-}+dropAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropAll streamLen n = composeN n $ StreamK.drop streamLen++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropWhileTrue streamLen n = composeN n $ StreamK.dropWhile (<= streamLen)++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: Monad m => Int -> StreamK m Int -> m ()+dropWhileFalse n = composeN n $ StreamK.dropWhile (<= 1)++{-# INLINE foldrS #-}+foldrS :: Monad m => Int -> StreamK m Int -> m ()+foldrS n = composeN n $ StreamK.foldrS StreamK.cons StreamK.nil++{-# INLINE foldlS #-}+foldlS :: Monad m => Int -> StreamK m Int -> m ()+foldlS n = composeN n $ StreamK.foldlS (flip StreamK.cons) StreamK.nil++{-# INLINE intersperse #-}+intersperse :: Monad m => Int -> Int -> StreamK m Int -> m ()+intersperse streamLen n = composeN n $ StreamK.intersperse streamLen++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource+    :: Monad m => Int -> (StreamK m Int -> StreamK m Int) -> Int -> Int -> StreamK m Int+iterateSource iterStreamLen g i n = f i (unfoldrM iterStreamLen n)+    where+        f (0 :: Int) m = g m+        f x m = g (f (x P.- 1) m)++-- this is quadratic+{-# INLINE iterateScan #-}+iterateScan :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateScan iterStreamLen maxIters =+    iterateSource iterStreamLen (StreamK.scanl' (+) 0) (maxIters `div` 10)++-- this is quadratic+{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileFalse streamLen iterStreamLen maxIters =+    iterateSource iterStreamLen (StreamK.dropWhile (> streamLen)) (maxIters `div` 10)++{-# INLINE iterateMapM #-}+iterateMapM :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateMapM iterStreamLen =+    iterateSource iterStreamLen (StreamK.mapMWith StreamK.consM return)++{-# INLINE iterateFilterEven #-}+iterateFilterEven :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateFilterEven iterStreamLen = iterateSource iterStreamLen (StreamK.filter even)++{-# INLINE iterateTakeAll #-}+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateTakeAll streamLen iterStreamLen =+    iterateSource iterStreamLen (StreamK.take streamLen)++{-# INLINE iterateDropOne #-}+iterateDropOne :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateDropOne iterStreamLen = iterateSource iterStreamLen (StreamK.drop 1)++{-# INLINE iterateDropWhileTrue #-}+iterateDropWhileTrue ::+    Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileTrue streamLen iterStreamLen =+    iterateSource iterStreamLen (StreamK.dropWhile (<= streamLen))++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-# INLINE zipWith #-}+zipWith :: Monad m => StreamK m Int -> m ()+zipWith src = drain $ StreamK.zipWith (,) src src++{-# INLINE zipWithM #-}+zipWithM :: Monad m => StreamK m Int -> m ()+zipWithM src = drain $ StreamK.zipWithM (curry return) src src++{-# INLINE sortByK #-}+sortByK :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a+sortByK f = StreamK.mergeMapWith (StreamK.mergeBy f) StreamK.fromPure++{-# INLINE sortBy #-}+sortBy :: Monad m => StreamK m Int -> m ()+sortBy = drain . sortByK compare++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+scanMap :: Monad m => Int -> StreamK m Int -> m ()+scanMap n = composeN n $ StreamK.map (subtract 1) . StreamK.scanl' (+) 0++{-# INLINE dropMap #-}+dropMap :: Monad m => Int -> StreamK m Int -> m ()+dropMap n = composeN n $ StreamK.map (subtract 1) . StreamK.drop 1++{-# INLINE dropScan #-}+dropScan :: Monad m => Int -> StreamK m Int -> m ()+dropScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.drop 1++{-# INLINE takeDrop #-}+takeDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.take streamLen++{-# INLINE takeScan #-}+takeScan :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeScan streamLen n = composeN n $ StreamK.scanl' (+) 0 . StreamK.take streamLen++{-# INLINE takeMap #-}+takeMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.take streamLen++{-# INLINE filterDrop #-}+filterDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.filter (<= streamLen)++{-# INLINE filterTake #-}+filterTake :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterTake streamLen n = composeN n $ StreamK.take streamLen . StreamK.filter (<= streamLen)++{-# INLINE filterScan #-}+filterScan :: Monad m => Int -> StreamK m Int -> m ()+filterScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound)++{-# INLINE filterMap #-}+filterMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter (<= streamLen)++-------------------------------------------------------------------------------+-- ConcatMap+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    StreamK.drain $ StreamK.concatMap+        (\_ -> unfoldrM inner n)+        (unfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMap+#endif++-- concatMap unfoldr/unfoldr++{-# INLINE concatMapPure #-}+concatMapPure :: Int -> Int -> Int -> IO ()+concatMapPure outer inner n =+    StreamK.drain $ StreamK.concatMap+        (\_ -> unfoldr inner n)+        (unfoldr outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapPure+#endif++-- concatMap replicate/unfoldrM++{-# INLINE concatMapRepl #-}+concatMapRepl :: Int -> Int -> Int -> IO ()+concatMapRepl outer inner n =+    StreamK.drain $ StreamK.concatMap (StreamK.replicate inner) (unfoldrM outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapRepl+#endif++-- concatMapWith++{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: Monad m+    => Int -> Int -> StreamK m (StreamK m Int)+sourceConcatMapId val n =+    StreamK.fromFoldable $ fmap (StreamK.fromEffect . return) [n..n+val]++{-# INLINE concatMapBySerial #-}+concatMapBySerial :: Int -> Int -> Int -> IO ()+concatMapBySerial outer inner n =+    StreamK.drain $ StreamK.concatMapWith StreamK.append+        (unfoldrM inner)+        (unfoldrM outer n)++-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++instance Monad m => Applicative (StreamK.StreamK m) where+    {-# INLINE pure #-}+    pure = StreamK.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = StreamK.crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = StreamK.crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = StreamK.crossApplyFst++-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,+-- the monad instance of StreamD is slower than StreamK after foldr/build+-- fusion.+instance Monad m => Monad (StreamK.StreamK m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip StreamK.concatMap++{-# INLINE drainApplicative #-}+drainApplicative :: Monad m => StreamK m Int -> m ()+drainApplicative s = drain $ do+    (+) <$> s <*> s++{-# INLINE drainMonad #-}+drainMonad :: Monad m => StreamK m Int -> m ()+drainMonad s = drain $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE drainConcatFor1 #-}+drainConcatFor1 :: Monad m => StreamK m Int -> m ()+drainConcatFor1 s = drain $ do+    StreamK.concatFor s $ \x ->+            StreamK.fromPure $ x + 1++{-# INLINE drainConcatFor #-}+drainConcatFor :: Monad m => StreamK m Int -> m ()+drainConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.fromPure $ x + y++{-# INLINE drainConcatForM #-}+drainConcatForM :: Monad m => StreamK m Int -> m ()+drainConcatForM s = drain $ do+    StreamK.concatForM s $ \x ->+        pure $ StreamK.concatForM s $ \y ->+            pure $ StreamK.fromPure $ x + y++{-# INLINE drainMonad3 #-}+drainMonad3 :: Monad m => StreamK m Int -> m ()+drainMonad3 s = drain $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE drainConcatFor3 #-}+drainConcatFor3 :: Monad m => StreamK m Int -> m ()+drainConcatFor3 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.fromPure $ x + y + z++{-# INLINE drainConcatFor3M #-}+drainConcatFor3M :: Monad m => StreamK m Int -> m ()+drainConcatFor3M s = drain $ do+    StreamK.concatForM s $ \x ->+        pure $ StreamK.concatForM s $ \y ->+            pure $ StreamK.concatForM s $ \z ->+                pure $ StreamK.fromPure $ x + y + z++{-# INLINE drainConcatFor4 #-}+drainConcatFor4 :: Monad m => StreamK m Int -> m ()+drainConcatFor4 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.concatFor s $ \w ->+                    StreamK.fromPure $ x + y + z + w++{-# INLINE drainConcatFor5 #-}+drainConcatFor5 :: Monad m => StreamK m Int -> m ()+drainConcatFor5 s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            StreamK.concatFor s $ \z ->+                StreamK.concatFor s $ \w ->+                    StreamK.concatFor s $ \u ->+                        StreamK.fromPure $ x + y + z + w + u++{-# INLINE filterAllOutMonad #-}+filterAllOutMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else StreamK.nil++{-# INLINE filterAllOutConcatFor #-}+filterAllOutConcatFor+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            let s1 = x + y+             in if s1 < 0+                then StreamK.fromPure s1+                else StreamK.nil++{-# INLINE filterAllInMonad #-}+filterAllInMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllInMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else StreamK.nil++{-# INLINE filterAllInConcatFor #-}+filterAllInConcatFor+    :: Monad m+    => StreamK m Int -> m ()+filterAllInConcatFor s = drain $ do+    StreamK.concatFor s $ \x ->+        StreamK.concatFor s $ \y ->+            let s1 = x + y+             in if s1 > 0+                then StreamK.fromPure s1+                else StreamK.nil++-------------------------------------------------------------------------------+-- Nested Composition Pure lists+-------------------------------------------------------------------------------++-- There are several list benchmarks here for comparison with lists. It is easy+-- and convenient to see the comparisons when they are here, otherwise we'll+-- have to add a separate module for list benchmarks with the same names and+-- then add a comparison in bench.sh.++{-# INLINE unfoldrList #-}+unfoldrList :: Int -> Int -> [Int]+unfoldrList maxval n = List.unfoldr step n+    where+    step cnt =+        if cnt > n + maxval+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE toNullApNestedList #-}+toNullApNestedList :: [Int] -> [Int]+toNullApNestedList s = (+) <$> s <*> s++{-# INLINE toNullNestedList #-}+toNullNestedList :: [Int] -> [Int]+toNullNestedList s = do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNestedList3 #-}+toNullNestedList3 :: [Int] -> [Int]+toNullNestedList3 s = do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNestedList #-}+filterAllOutNestedList :: [Int] -> [Int]+filterAllOutNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else []++{-# INLINE filterAllInNestedList #-}+filterAllInNestedList :: [Int] -> [Int]+filterAllInNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else []++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.StreamK"++o_1_space_generation :: Int -> Benchmark+o_1_space_generation streamLen =+    bgroup "generation"+        [ benchFold "unfoldr" drain (unfoldr streamLen)+        , benchFold "unfoldrM" drain (unfoldrM streamLen)+        , benchFold "repeat" drain (repeat streamLen)+        , benchFold "repeatM" drain (repeatM streamLen)+        , benchFold "replicate" drain (replicate streamLen)+        , benchFold "replicateM" drain (replicateM streamLen)+        , benchFold "iterate" drain (iterate streamLen)+        , benchFold "iterateM" drain (iterateM streamLen)++        , benchFold "fromFoldable"  drain (fromFoldable streamLen)+        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)++        -- appends+        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)+        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)+        ]++o_1_space_elimination :: Int -> Benchmark+o_1_space_elimination streamLen =+    bgroup "elimination"+        [ benchFold "toNull"   drain   (unfoldrM streamLen)+        , benchFold "mapM_"    mapM_    (unfoldrM streamLen)+        , benchFold "uncons"   uncons   (unfoldrM streamLen)+        , benchFold "init"   init     (unfoldrM streamLen)+        , benchFold "foldl'" foldl'    (unfoldrM streamLen)+        , benchFold "foldlM'" foldlM' (unfoldrM streamLen)+        , benchFold "last"   last     (unfoldrM streamLen)+        ]++o_1_space_ap :: Int -> Benchmark+o_1_space_ap streamLen =+    bgroup "Applicative"+        [ benchFold "drain2" drainApplicative (unfoldrM streamLen2)+        , benchFold "pureDrain2" drainApplicative (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_1_space_monad :: Int -> Benchmark+o_1_space_monad streamLen =+    bgroup "Monad"+        [ benchFold "drain2"   drainMonad   (unfoldrM streamLen2)+        , benchFold "drain3"  drainMonad3  (unfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInMonad  (unfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutMonad (unfoldrM streamLen2)+        , benchFold "pureDrain2"   drainMonad   (unfoldr streamLen2)+        , benchFold "pureDrain3"  drainMonad3  (unfoldr streamLen3)+        , benchFold "pureFilterAllIn2"  filterAllInMonad  (unfoldr streamLen2)+        , benchFold "pureFilterAllOut2" filterAllOutMonad (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop++o_1_space_bind :: Int -> Benchmark+o_1_space_bind streamLen =+    bgroup "concatFor"+        [ benchFold "drain1"   drainConcatFor1   (unfoldrM streamLen)+        , benchFold "drain2"   drainConcatFor   (unfoldrM streamLen2)+        , benchFold "drainM2"   drainConcatForM   (unfoldrM streamLen2)+        , benchFold "drain3"   drainConcatFor3   (unfoldrM streamLen3)+        , benchFold "drain4"   drainConcatFor4   (unfoldrM streamLen4)+        , benchFold "drain5"   drainConcatFor5   (unfoldrM streamLen5)+        , benchFold "drainM3"   drainConcatFor3M   (unfoldrM streamLen3)+        , benchFold "filterAllIn2"  filterAllInConcatFor  (unfoldrM streamLen2)+        , benchFold "filterAllOut2" filterAllOutConcatFor (unfoldrM streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop+    streamLen4 = round (P.fromIntegral streamLen**(1/4::P.Double)) -- 4 times nested loop+    streamLen5 = round (P.fromIntegral streamLen**(1/5::P.Double)) -- 5 times nested loop++o_1_space_transformation :: Int -> Benchmark+o_1_space_transformation streamLen =+    bgroup "transformation"+        [ benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)+        , benchFold "scanl'"   (scanl' 1) (unfoldrM streamLen)+        , benchFold "map"    (map  1) (unfoldrM streamLen)+        , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 1) (unfoldrM streamLen)+        , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)+        ]++o_1_space_transformationX4 :: Int -> Benchmark+o_1_space_transformationX4 streamLen =+    bgroup "transformationX4"+        [ benchFold "scanl'"   (scanl' 4) (unfoldrM streamLen)+        , benchFold "map"    (map  4) (unfoldrM streamLen)+        , benchFold "fmap"   (fmapK 4) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 4) (unfoldrM streamLen)+        , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)+        -- XXX this is horribly slow+        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)+        ]++o_1_space_concat :: Int -> Benchmark+o_1_space_concat streamLen =+    bgroup "concat"+        [ benchIOSrc1 "concatMapPure outer=Max inner=1"+            (concatMapPure streamLen 1)+        , benchIOSrc1 "concatMapPure outer=inner=(sqrt Max)"+            (concatMapPure streamLen2 streamLen2)+        , benchIOSrc1 "concatMapPure outer=1 inner=Max"+            (concatMapPure 1 streamLen)++        , benchIOSrc1 "concatMap outer=Max inner=1"+            (concatMap streamLen 1)+        , benchIOSrc1 "concatMap outer=inner=(sqrt Max)"+            (concatMap streamLen2 streamLen2)+        , benchIOSrc1 "concatMap outer=1 inner=Max"+            (concatMap 1 streamLen)++        , benchIOSrc1 "concatMapRepl outer=inner=(sqrt Max)"+            (concatMapRepl streamLen2 streamLen2)++        -- This is for comparison with concatMapFoldableWith+        , benchIOSrc1 "concatMapWithId outer=Max inner=1 (fromFoldable)"+            (StreamK.drain+                . StreamK.concatMapWith StreamK.append id+                . sourceConcatMapId streamLen)++        , benchIOSrc1 "concatMapWith append outer=Max inner=1"+            (concatMapBySerial streamLen 1)+        , benchIOSrc1 "concatMapWith append outer=inner=(sqrt Max)"+            (concatMapBySerial streamLen2 streamLen2)+        , benchIOSrc1 "concatMapWith append outer=1 inner=Max"+            (concatMapBySerial 1 streamLen)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_1_space_filtering :: Int -> Benchmark+o_1_space_filtering streamLen =+    bgroup "filtering"+        [ benchFold "filter-even"     (filterEven     1) (unfoldrM streamLen)+        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)+        ]++o_1_space_filteringX4 :: Int -> Benchmark+o_1_space_filteringX4 streamLen =+    bgroup "filteringX4"+        [ benchFold "filter-even"     (filterEven     4) (unfoldrM streamLen)+        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)+        ]++o_1_space_zipping :: Int -> Benchmark+o_1_space_zipping streamLen =+    bgroup "zipping"+        [ benchFold "zipWith" zipWith (unfoldrM streamLen)+        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)+        ]++o_1_space_mixed :: Int -> Benchmark+o_1_space_mixed streamLen =+    bgroup "mixed"+        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)+        ]++o_1_space_mixedX2 :: Int -> Benchmark+o_1_space_mixedX2 streamLen =+    bgroup "mixedX2"+        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)+        ]++o_1_space_mixedX4 :: Int -> Benchmark+o_1_space_mixedX4 streamLen =+    bgroup "mixedX4"+        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)+        ]++o_1_space_list :: Int -> Benchmark+o_1_space_list streamLen =+    bgroup "list"+      [ bgroup "elimination"+        [ benchList "last" (\xs -> [List.last xs]) (unfoldrList streamLen)+        ]+      , bgroup "Applicative"+        [ benchList "drain2" toNullApNestedList (unfoldrList streamLen2)+        ]+      , bgroup "Monad"+        [ benchList "drain2"   toNullNestedList (unfoldrList streamLen2)+        , benchList "drain3"  toNullNestedList3 (unfoldrList streamLen3)+        , benchList "filterAllIn2"  filterAllInNestedList (unfoldrList streamLen2)+        , benchList "filterAllOut2"  filterAllOutNestedList (unfoldrList streamLen2)+        ]+      ]+    where++    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop++o_1_space :: Int -> Benchmark+o_1_space streamLen =+    bgroup (o_1_space_prefix moduleName)+      [ o_1_space_generation streamLen+      , o_1_space_elimination streamLen+      , o_1_space_ap streamLen+      , o_1_space_monad streamLen+      , o_1_space_bind streamLen+      , o_1_space_transformation streamLen+      , o_1_space_transformationX4 streamLen+      , o_1_space_concat streamLen+      , o_1_space_filtering streamLen+      , o_1_space_filteringX4 streamLen+      , o_1_space_zipping streamLen+      , o_1_space_mixed streamLen+      , o_1_space_mixedX2 streamLen+      , o_1_space_mixedX4 streamLen+      , o_1_space_list streamLen+      ]++o_n_heap :: Int -> Benchmark+o_n_heap streamLen =+    bgroup (o_n_heap_prefix moduleName)+      [ bgroup "transformation"+        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)+        ]+      , bgroup "concat"+        [ benchFold "sortBy" sortBy (unfoldrM streamLen)+        ]+      ]++{-# INLINE benchK #-}+benchK :: P.String -> (Int -> StreamK P.IO Int) -> Benchmark+benchK name f = bench name $ nfIO $ randomRIO (1,1) >>= drain . f++o_n_stack :: Int -> Int -> Int -> Benchmark+o_n_stack streamLen iterStreamLen maxIters =+    bgroup (o_n_stack_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "tail"   tail     (unfoldrM streamLen)+        , benchFold "nullTail" nullTail (unfoldrM streamLen)+        , benchFold "headTail" headTail (unfoldrM streamLen)+        ]+      , bgroup "transformation"+        [+          -- XXX why do these need so much stack+          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)+        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)+        ]+      , bgroup "transformationX4"+        [+          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)+        ]+      , bgroup "iterated"+        [ benchK "mapM"                 (iterateMapM iterStreamLen maxIters)+        , benchK "scan(1/10)"           (iterateScan iterStreamLen maxIters)+        , benchK "filterEven"           (iterateFilterEven iterStreamLen maxIters)+        , benchK "takeAll"              (iterateTakeAll streamLen iterStreamLen maxIters)+        , benchK "dropOne"              (iterateDropOne iterStreamLen maxIters)+        , benchK "dropWhileFalse(1/10)" (iterateDropWhileFalse streamLen iterStreamLen maxIters)+        , benchK "dropWhileTrue"        (iterateDropWhileTrue streamLen iterStreamLen maxIters)+        ]+      ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop++o_n_space :: Int -> Benchmark+o_n_space streamLen =+    bgroup (o_n_space_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "toList" toList   (unfoldrM streamLen)+        ]+      ]++{- HLINT ignore "Use <&>" -}+{-# INLINE benchList #-}+benchList :: P.String -> ([Int] -> [Int]) -> (Int -> [Int]) -> Benchmark+benchList name run f = bench name $ nfIO $ randomRIO (1,1) >>= return . run . f++main :: IO ()+main = do+    runWithCLIOpts defaultStreamSize allBenchmarks++    where++    allBenchmarks streamLen =+        let !iterStreamLen = 10+            !maxIters = streamLen `div` iterStreamLen+         in [ o_1_space streamLen+            , o_n_stack streamLen iterStreamLen maxIters+            , o_n_heap streamLen+            , o_n_space streamLen+            ]
+ benchmark/Streamly/Benchmark/Data/StreamK/FromStream.hs view
@@ -0,0 +1,1497 @@+-- |+-- Module      : Streamly.Benchmark.Data.StreamK.FromStream+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+--+-- There are two ways to benchmark mixed use of Stream and StreamK.+--+-- First, benchmark one StreamK operation using all other operations from+-- Stream. This is for comparison of all pure StreamK operations vs using+-- operations from Stream whenever possible. We should compare these benchmarks+-- with pure StreamK benchmarks.+--+-- Second, benchmark one Stream operation with all other operations from+-- StreamK.+--+-- XXX This module uses both of the above, we need to separate the two in+-- separate benchmark groups.++{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++module Main (main) where++-- import Control.Applicative (liftA2)+-- import Control.Monad (when)+-- import Data.Maybe (isJust)+-- import System.Random (randomRIO)++import Control.DeepSeq (NFData(..))+import Control.Exception (try)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.State.Strict (StateT, get, put)+import Data.Functor.Identity (Identity, runIdentity)+import GHC.Exception (ErrorCall)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK, CrossStreamK)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Random (randomRIO)+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain, nf, nfIO, bench)++import qualified Prelude as P+-- import qualified Data.List as List+import qualified Control.Monad.State.Strict as State+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Fold as Fold++import Prelude hiding+    ( tail, mapM_, foldl, last, map, mapM, concatMap, zipWith, init, iterate+    , repeat, replicate, reverse+    )+import Streamly.Benchmark.Common+#ifdef INSPECTION+import Test.Inspection+#endif++-------------------------------------------------------------------------------+-- Bench utilities+-------------------------------------------------------------------------------++{-# NOINLINE benchIO #-}+benchIO :: (NFData b) => String -> (Int -> IO b) -> Benchmark+benchIO name f = bench name $ nfIO $ randomRIO (1,1) >>= f++-- | Takes a source, and uses it with a default drain/fold method.+{-# INLINE benchIOSrc #-}+benchIOSrc+    :: String+    -> (Int -> StreamK IO a)+    -> Benchmark+benchIOSrc name f =+    bench name $ nfIO $ randomRIO (1,1) >>= drain . f++{-# INLINE benchIOSink #-}+benchIOSink+    :: (NFData b)+    => Int -> String -> (StreamK IO Int -> IO b) -> Benchmark+benchIOSink value name f =+    bench name $ nfIO $ randomRIO (1,1) >>= f . unfoldrMD value++-- XXX We should be using sourceUnfoldrM for fair comparison with IO monad, but+-- we can't use it as it requires MonadAsync constraint.+{-# INLINE benchIdentitySink #-}+benchIdentitySink+    :: (NFData b)+    => Int -> String -> (Stream Identity Int -> Identity b) -> Benchmark+benchIdentitySink value name f = bench name $ nf (f . unfoldr value) 1++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++{-# INLINE unfoldr #-}+unfoldr :: Monad m => Int -> Int -> Stream m Int+unfoldr streamLen n = Stream.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE unfoldrD #-}+unfoldrD :: Monad m => Int -> Int -> StreamK m Int+unfoldrD streamLen n = Stream.toStreamK $ unfoldr streamLen n++{-# INLINE unfoldrMD #-}+unfoldrMD :: Monad m => Int -> Int -> StreamK m Int+unfoldrMD streamLen n = Stream.toStreamK (Stream.unfoldrM step n)+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-+{-# INLINE unfoldrK #-}+unfoldrK :: Int -> Int -> StreamK m Int+unfoldrK streamLen n = StreamK.unfoldr step n+    where+    step cnt =+        if cnt > n + streamLen+        then Nothing+        else Just (cnt, cnt + 1)+-}++{-# INLINE unfoldrMK #-}+unfoldrMK :: Monad m => Int -> Int -> StreamK m Int+unfoldrMK streamLen n = StreamK.unfoldrMWith StreamK.consM step n+    where+    step cnt =+        if cnt > n + streamLen+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-# INLINE repeat #-}+repeat :: Monad m => Int -> Int -> StreamK m Int+repeat streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.repeat++{-# INLINE repeatM #-}+repeatM :: Monad m => Int -> Int -> StreamK m Int+repeatM streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.repeatM . return++{-# INLINE replicate #-}+replicate :: Monad m => Int -> Int -> StreamK m Int+replicate x y = Stream.toStreamK $ Stream.replicate x y++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> Int -> StreamK m Int+replicateM streamLen = Stream.toStreamK . Stream.replicateM streamLen . return++{-# INLINE iterate #-}+iterate :: Monad m => Int -> Int -> StreamK m Int+iterate streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.iterate (+1)++{-# INLINE iterateM #-}+iterateM :: Monad m => Int -> Int -> StreamK m Int+iterateM streamLen = StreamK.take streamLen . Stream.toStreamK . Stream.iterateM (return . (+1)) . return++{-# INLINE fromFoldable #-}+fromFoldable :: Int -> Int -> StreamK m Int+fromFoldable streamLen n = StreamK.fromFoldable [n..n+streamLen]++{-# INLINE fromFoldableM #-}+fromFoldableM :: Monad m => Int -> Int -> StreamK m Int+fromFoldableM streamLen n =+    Prelude.foldr (StreamK.consM . return) StreamK.nil [n .. n + streamLen]++{-+{-# INLINABLE concatMapFoldableWith #-}+concatMapFoldableWith :: Foldable f+    => (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> f a+    -> StreamK m b+concatMapFoldableWith f g = Prelude.foldr (f . g) StreamK.nil+-}++{-# INLINE concatMapFoldableSerial #-}+concatMapFoldableSerial :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerial streamLen n =+    Stream.toStreamK $ Stream.concatMap Stream.fromPure $ Stream.fromStreamK $ StreamK.fromList [n..n+streamLen]++{-# INLINE concatMapFoldableSerialM #-}+concatMapFoldableSerialM :: Monad m => Int -> Int -> StreamK m Int+concatMapFoldableSerialM streamLen n =+    -- concatMapFoldableWith StreamK.serial (StreamK.fromEffect . return) [n..n+streamLen]+    Stream.toStreamK $ Stream.concatMap (Stream.fromEffect . return) $ Stream.fromStreamK $ StreamK.fromList [n..n+streamLen]++{-# INLINE mfixUnfold #-}+mfixUnfold :: Int -> Int -> StreamK IO (Int, Int)+mfixUnfold count start = StreamK.mfix f+    where+    f action = StreamK.unCross $ do+        let incr n act = fmap ((+n) . snd)  $ unsafeInterleaveIO act+        x <- StreamK.mkCross (StreamK.fromStream $ Stream.fromListM [incr 1 action, incr 2 action])+        y <- StreamK.mkCross (unfoldrD count start)+        return (x, y)++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE drainD #-}+drainD :: Monad m => StreamK m a -> m ()+drainD = Stream.drain . Stream.fromStreamK++{-# INLINE drain #-}+drain :: Monad m => StreamK m a -> m ()+-- XXX Use "Stream" instead of "StreamK" when eliminating?+-- drain = drainD+drain = StreamK.drain++{-# INLINE mapM_ #-}+mapM_ :: Monad m => StreamK m a -> m ()+mapM_ s = Stream.mapM_ (\_ -> return ()) $ Stream.fromStreamK s++{-# INLINE uncons #-}+uncons :: Monad m => StreamK m Int -> m ()+uncons s = do+    r <- StreamK.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++-- Recursive call, does it work well?+{-# INLINE unconsD #-}+unconsD :: Monad m => StreamK m Int -> m ()+unconsD s = do+    r <- Stream.uncons $ Stream.fromStreamK s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons (Stream.toStreamK t)++{-+{-# INLINE init #-}+init :: Monad m => StreamK m a -> m ()+init s = do+    t <- StreamK.init s+    P.mapM_ StreamK.drain t++{-# INLINE tail #-}+tail :: Monad m => StreamK m a -> m ()+tail s = StreamK.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+nullTail :: Monad m => StreamK m Int -> m ()+nullTail s = do+    r <- StreamK.null s+    when (not r) $ StreamK.tail s >>= P.mapM_ nullTail++{-# INLINE headTail #-}+headTail :: Monad m => StreamK m Int -> m ()+headTail s = do+    h <- StreamK.head s+    when (isJust h) $ StreamK.tail s >>= P.mapM_ headTail+-}++{-# INLINE toList #-}+toList :: Monad m => StreamK m Int -> m [Int]+toList = Stream.fold Fold.toList . Stream.fromStreamK++{-# INLINE foldl' #-}+foldl' :: Monad m => StreamK m Int -> m Int+foldl' = Stream.fold (Fold.foldl' (+) 0) . Stream.fromStreamK++{-# INLINE last #-}+last :: Monad m => StreamK m Int -> m (Maybe Int)+last = Stream.fold Fold.latest . Stream.fromStreamK++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (StreamK m Int -> StreamK m Int) -> StreamK m Int -> m ()+composeN n f =+    case n of+        1 -> drain . f+        2 -> drain . f . f+        3 -> drain . f . f . f+        4 -> drain . f . f . f . f+        _ -> undefined++{-# INLINE scanl' #-}+scanl' :: Monad m => Int -> StreamK m Int -> m ()+scanl' n =+    composeN n (Stream.toStreamK . Stream.scan (Fold.foldl' (+) 0) . Stream.fromStreamK)++{-# INLINE map #-}+map :: Monad m => Int -> StreamK m Int -> m ()+map n = composeN n (Stream.toStreamK . Stream.map (+ 1) . Stream.fromStreamK)++{-+{-# INLINE fmapK #-}+fmapK :: Monad m => Int -> StreamK m Int -> m ()+fmapK n = composeN n $ P.fmap (+ 1)+-}++{-# INLINE mapM #-}+mapM :: Monad m => Int -> StreamK m Int -> m ()+mapM n = composeN n (Stream.toStreamK . Stream.mapM return . Stream.fromStreamK)++{-+{-# INLINE mapMSerial #-}+mapMSerial :: StreamK.MonadAsync m => Int -> StreamK m Int -> m ()+mapMSerial n = composeN n $ StreamK.mapMSerial return+-}++{-# INLINE filterEven #-}+filterEven :: Monad m => Int -> StreamK m Int -> m ()+filterEven n = composeN n (Stream.toStreamK . Stream.filter even . Stream.fromStreamK)++{-+{-# INLINE filterAllOut #-}+filterAllOut :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllOut streamLen n = composeN n $ StreamK.filter (> streamLen)++{-# INLINE filterAllIn #-}+filterAllIn :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterAllIn streamLen n = composeN n $ StreamK.filter (<= streamLen)++{-# INLINE _takeOne #-}+_takeOne :: Monad m => Int -> StreamK m Int -> m ()+_takeOne n = composeN n $ StreamK.take 1++{-# INLINE takeAll #-}+takeAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeAll streamLen n = composeN n $ StreamK.take streamLen++{-# INLINE takeWhileTrue #-}+takeWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeWhileTrue streamLen n = composeN n $ StreamK.takeWhile (<= streamLen)++{-# INLINE dropOne #-}+dropOne :: Monad m => Int -> StreamK m Int -> m ()+dropOne n = composeN n $ StreamK.drop 1++{-# INLINE dropAll #-}+dropAll :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropAll streamLen n = composeN n $ StreamK.drop streamLen++{-# INLINE dropWhileTrue #-}+dropWhileTrue :: Monad m => Int -> Int -> StreamK m Int -> m ()+dropWhileTrue streamLen n = composeN n $ StreamK.dropWhile (<= streamLen)++{-# INLINE dropWhileFalse #-}+dropWhileFalse :: Monad m => Int -> StreamK m Int -> m ()+dropWhileFalse n = composeN n $ StreamK.dropWhile (<= 1)+-}++{-+{-# INLINE foldlS #-}+foldlS :: Monad m => Int -> StreamK m Int -> m ()+foldlS n = composeN n $ StreamK.foldlS (flip StreamK.cons) StreamK.nil+-}++{-# INLINE foldrS #-}+foldrS :: MonadIO m => Int -> StreamK m Int -> m ()+foldrS n =+    composeN n (StreamK.foldrS StreamK.cons StreamK.nil)++{-# INLINE foldrSMap #-}+foldrSMap :: MonadIO m => Int -> StreamK m Int -> m ()+foldrSMap n =+    composeN n+        (+          StreamK.foldrS (\x xs -> x + 1 `StreamK.cons` xs) StreamK.nil+        )++{-# INLINE foldrToStream #-}+foldrToStream :: Monad m => Stream m Int -> m (StreamK Identity Int)+foldrToStream = Stream.foldr StreamK.cons StreamK.nil++{-+{-# INLINE intersperse #-}+intersperse :: StreamK.MonadAsync m => Int -> Int -> StreamK m Int -> m ()+intersperse streamLen n = composeN n $ StreamK.intersperse streamLen+-}++-------------------------------------------------------------------------------+-- Traversable Instance+-------------------------------------------------------------------------------++{-# INLINE traversableTraverse #-}+traversableTraverse :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableTraverse = traverse return++{- HLINT ignore "Use traverse" -}+{-# INLINE traversableSequenceA #-}+traversableSequenceA :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableSequenceA = sequenceA . Prelude.fmap return++{-# INLINE traversableMapM #-}+traversableMapM :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableMapM = P.mapM return++{- HLINT ignore "Use mapM" -}+{-# INLINE traversableSequence #-}+traversableSequence :: StreamK Identity Int -> IO (StreamK Identity Int)+traversableSequence = Prelude.sequence . Prelude.fmap return++{-# INLINE benchPureSinkIO #-}+benchPureSinkIO+    :: NFData b+    => Int -> String -> (StreamK Identity Int -> IO b) -> Benchmark+benchPureSinkIO value name f =+    bench name+        $ nfIO $ randomRIO (1, 1) >>= f . unfoldrD value++instance NFData a => NFData (StreamK Identity a) where+    {-# INLINE rnf #-}+    rnf xs =+        runIdentity+            $ Stream.fold (Fold.foldl' (\_ x -> rnf x) ()) (StreamK.toStream xs)++o_n_space_traversable :: Int -> Benchmark+o_n_space_traversable value =+    -- Buffering operations using heap proportional to number of elements.+    bgroup "traversable"+        -- Traversable instance+        [ benchPureSinkIO value "traverse" traversableTraverse+        , benchPureSinkIO value "sequenceA" traversableSequenceA+        , benchPureSinkIO value "mapM" traversableMapM+        , benchPureSinkIO value "sequence" traversableSequence+        ]++o_1_space_mapping :: Int -> Benchmark+o_1_space_mapping value =+    bgroup+        "mapping"+        [+        -- Right folds+          benchIOSink value "foldrS" (foldrS 1)+        , benchIOSink value "foldrSMap" (foldrSMap 1)+        ]++-------------------------------------------------------------------------------+-- Iteration of transformations+-------------------------------------------------------------------------------++{-# INLINE iterateSource #-}+iterateSource ::+       Monad m+    => (StreamK m Int -> StreamK m Int)+    -> Int+    -> Int+    -> Int+    -> StreamK m Int+iterateSource g count len n = f count (unfoldrMD len n)++    where++    f (0 :: Int) stream = stream+    f i stream = f (i - 1) (g stream)++-- this is quadratic+{-# INLINE iterateScan #-}+iterateScan :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateScan = iterateSource (StreamK.scanl' (+) 0)++{-# INLINE iterateMapM #-}+iterateMapM :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateMapM = iterateSource (StreamK.mapM return)++{-# INLINE iterateFilterEven #-}+iterateFilterEven :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateFilterEven = iterateSource (StreamK.filter even)++{-# INLINE iterateTakeAll #-}+iterateTakeAll :: Monad m => Int -> Int -> Int -> Int -> StreamK m Int+iterateTakeAll value = iterateSource (StreamK.take (value + 1))++{-# INLINE iterateDropOne #-}+iterateDropOne :: Monad m => Int -> Int -> Int -> StreamK m Int+iterateDropOne = iterateSource (StreamK.drop 1)++{-# INLINE iterateDropWhileTrue #-}+iterateDropWhileTrue :: Monad m+    => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileTrue value = iterateSource (StreamK.dropWhile (<= (value + 1)))++{-# INLINE iterateDropWhileFalse #-}+iterateDropWhileFalse :: Monad m+    => Int -> Int -> Int -> Int -> StreamK m Int+iterateDropWhileFalse value = iterateSource (StreamK.dropWhile (> (value + 1)))++-- Head recursive operations.+o_n_stack_iterated :: Int -> Benchmark+o_n_stack_iterated value = by10 `seq` by100 `seq`+    bgroup "iterated"+        [+          benchIOSrc "mapM (n/10 x 10)" $ iterateMapM by10 10+        , benchIOSrc "scanl' (quadratic) (n/100 x 100)" $+            iterateScan by100 100+        , benchIOSrc "filterEven (n/10 x 10)" $+            iterateFilterEven by10 10+        , benchIOSrc "takeAll (n/10 x 10)" $+            iterateTakeAll value by10 10+        , benchIOSrc "dropOne (n/10 x 10)" $ iterateDropOne by10 10+        , benchIOSrc "dropWhileTrue (n/10 x 10)" $+            iterateDropWhileTrue value by10 10+        , benchIOSrc "dropWhileFalse (n/10 x 10)" $+            iterateDropWhileFalse value by10 10+        {-+        , benchFold "tail"   tail     (unfoldrM streamLen)+        , benchFold "nullTail" nullTail (unfoldrM streamLen)+        , benchFold "headTail" headTail (unfoldrM streamLen)+        -}+        ]++    where++    by10 = value `div` 10+    by100 = value `div` 100++-------------------------------------------------------------------------------+-- Iteration Applicative+-------------------------------------------------------------------------------++{-# INLINE iterateN #-}+iterateN :: (Int -> a -> a) -> a -> Int -> a+iterateN g initial count = f count initial++    where++    f (0 :: Int) x = x+    f i x = f (i - 1) (g i x)++-- Iterate a transformation over a singleton stream+{-# INLINE iterateSingleton #-}+iterateSingleton ::+       (Int -> CrossStreamK m Int -> CrossStreamK m Int)+    -> Int+    -> Int+    -> StreamK m Int+iterateSingleton g count n =+      StreamK.unCross+    $ iterateN g (StreamK.mkCross (StreamK.fromPure n)) count++{-+-- XXX need to check why this is slower than the explicit recursion above, even+-- if the above code is written in a foldr like head recursive way. We also+-- need to try this with foldlM' once #150 is fixed.+-- However, it is perhaps best to keep the iteration benchmarks independent of+-- foldrM and any related fusion issues.+{-# INLINE _iterateSingleton #-}+_iterateSingleton ::+       Monad m+    => (Int -> Stream m Int -> Stream m Int)+    -> Int+    -> Int+    -> Stream m Int+_iterateSingleton g value n = S.foldrM g (return n) $ sourceIntFromTo value n+-}++{- HLINT ignore "Redundant <*" -}+o_n_space_applicative :: Int -> Benchmark+o_n_space_applicative value =+    bgroup "iterated"+        [ benchIOSrc "(*>) (n times)" $+            iterateSingleton ((*>) . pure) value+        , benchIOSrc "(<*) (n times)" $+            iterateSingleton (\x xs -> xs <* pure x) value+        , benchIOSrc "(<*>) (n times)" $+            iterateSingleton (\x xs -> pure (+ x) <*> xs) value+        , benchIOSrc "liftA2 (n times)" $+            iterateSingleton (liftA2 (+) . pure) value+        ]++-------------------------------------------------------------------------------+-- Iteration Monadic+-------------------------------------------------------------------------------++-- This is a good benchmark but inefficient way to compute primes. As we see a+-- new prime we keep appending a division filter for all the future numbers.+{-# INLINE sieve #-}+sieve :: Monad m => StreamK m Int -> StreamK m Int+sieve s = StreamK.concatEffect $ do+    r <- StreamK.uncons s+    case r of+        Just (prime, rest) ->+            -- XXX Use K.filter or rewrite to K.filter+            let f = Stream.filter (\n -> n `mod` prime /= 0)+             in pure $ prime `StreamK.cons` sieve (StreamK.fromStream $ f $ StreamK.toStream rest)+        Nothing -> pure StreamK.nil++o_n_space_iterated :: Int -> Benchmark+o_n_space_iterated value =+    bgroup "iterated"+        [+          benchIO "concatEffect prime sieve (n/4)"+            (\n ->+                  Stream.fold Fold.sum+                $ StreamK.toStream+                $ sieve+                $ StreamK.fromStream+                $ Stream.enumerateFromTo 2 (value `div` 4 + n))+        , benchIOSrc "(>>) (n times)" $+            iterateSingleton ((>>) . pure) value+        , benchIOSrc "(>>=) (n times)" $+            iterateSingleton (\x xs -> xs >>= \y -> return (x + y)) value+        ]++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++{-+{-# INLINE zipWith #-}+zipWith :: Monad m => StreamK m Int -> m ()+zipWith src = drain $ StreamK.zipWith (,) src src++{-# INLINE zipWithM #-}+zipWithM :: Monad m => StreamK m Int -> m ()+zipWithM src = drain $ StreamK.zipWithM (curry return) src src++{-# INLINE sortByK #-}+sortByK :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a+sortByK f = StreamK.concatPairsWith (StreamK.mergeBy f) StreamK.fromPure++{-# INLINE sortBy #-}+sortBy :: Monad m => StreamK m Int -> m ()+sortBy = drain . sortByK compare++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+scanMap :: Monad m => Int -> StreamK m Int -> m ()+scanMap n = composeN n $ StreamK.map (subtract 1) . StreamK.scanl' (+) 0++{-# INLINE dropMap #-}+dropMap :: Monad m => Int -> StreamK m Int -> m ()+dropMap n = composeN n $ StreamK.map (subtract 1) . StreamK.drop 1++{-# INLINE dropScan #-}+dropScan :: Monad m => Int -> StreamK m Int -> m ()+dropScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.drop 1++{-# INLINE takeDrop #-}+takeDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.take streamLen++{-# INLINE takeScan #-}+takeScan :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeScan streamLen n = composeN n $ StreamK.scanl' (+) 0 . StreamK.take streamLen++{-# INLINE takeMap #-}+takeMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+takeMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.take streamLen++{-# INLINE filterDrop #-}+filterDrop :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterDrop streamLen n = composeN n $ StreamK.drop 1 . StreamK.filter (<= streamLen)++{-# INLINE filterTake #-}+filterTake :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterTake streamLen n = composeN n $ StreamK.take streamLen . StreamK.filter (<= streamLen)++{-# INLINE filterScan #-}+filterScan :: Monad m => Int -> StreamK m Int -> m ()+filterScan n = composeN n $ StreamK.scanl' (+) 0 . StreamK.filter (<= maxBound)++{-# INLINE filterMap #-}+filterMap :: Monad m => Int -> Int -> StreamK m Int -> m ()+filterMap streamLen n = composeN n $ StreamK.map (subtract 1) . StreamK.filter (<= streamLen)+-}++-------------------------------------------------------------------------------+-- Applicative+-------------------------------------------------------------------------------++{-# INLINE apDiscardFst #-}+apDiscardFst :: Monad m =>+    Int -> Int -> m ()+apDiscardFst linearCount start = drain $ StreamK.unCross $+    StreamK.mkCross (unfoldrMD nestedCount2 start)+        *> StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apDiscardSnd #-}+apDiscardSnd :: Monad m => Int -> Int -> m ()+apDiscardSnd linearCount start = drain $ StreamK.unCross $+    StreamK.mkCross (unfoldrMD nestedCount2 start)+        <* StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE apLiftA2 #-}+apLiftA2 :: Monad m => Int -> Int -> m ()+apLiftA2 linearCount start = drain $ StreamK.unCross $+    liftA2 (+) (StreamK.mkCross (unfoldrMD nestedCount2 start))+        (StreamK.mkCross (unfoldrMD nestedCount2 start))++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullAp #-}+toNullAp :: Monad m => Int -> Int -> m ()+toNullAp linearCount start = drain $ StreamK.unCross $+    (+) <$> StreamK.mkCross (unfoldrMD nestedCount2 start)+        <*> StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_applicative :: Int -> Benchmark+o_1_space_applicative value =+    bgroup "Applicative"+        [ benchIO "(*>) (sqrt n x sqrt n)" $ apDiscardFst value+        , benchIO "(<*) (sqrt n x sqrt n)" $ apDiscardSnd value+        , benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp value+        , benchIO "liftA2 (sqrt n x sqrt n)" $ apLiftA2 value+        ]++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++{-# INLINE monadThen #-}+monadThen :: Monad m => Int -> Int -> m ()+monadThen linearCount start = drain $ StreamK.unCross $ do+    StreamK.mkCross (unfoldrMD nestedCount2 start) >>+        StreamK.mkCross (unfoldrMD nestedCount2 start)++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM #-}+toNullM :: Monad m => Int -> Int -> m ()+toNullM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    return $ x + y++    where++    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toNullM3 #-}+toNullM3 :: Monad m => Int -> Int -> m ()+toNullM3 linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    z <- StreamK.mkCross (unfoldrMD nestedCount3 start)+    return $ x + y + z+  where+    nestedCount3 = round (fromIntegral linearCount**(1/3::Double))++{-# INLINE filterAllOutM #-}+filterAllOutM :: Monad m => Int -> Int -> m ()+filterAllOutM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s < 0+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterAllInM #-}+filterAllInM :: Monad m => Int -> Int -> m ()+filterAllInM linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s > 0+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE filterSome #-}+filterSome :: Monad m => Int -> Int -> m ()+filterSome linearCount start = drain $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    let s = x + y+    if s > 1100000+    then return s+    else StreamK.mkCross StreamK.nil+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE breakAfterSome #-}+breakAfterSome :: Int -> Int -> IO ()+breakAfterSome linearCount start = do+    (_ :: Either ErrorCall ()) <- try $ drain $ StreamK.unCross $ do+        x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        let s = x + y+        if s > 1100000+        then error "break"+        else return s+    return ()+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++{-# INLINE toListM #-}+toListM :: Monad m => Int -> Int -> m [Int]+toListM linearCount start = toList $ StreamK.unCross $ do+    x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+    return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++-- Taking a specified number of elements is very expensive in logict so we have+-- a test to measure the same.+{-# INLINE toListSome #-}+toListSome :: Monad m => Int -> Int -> m [Int]+toListSome linearCount start =+    toList $ StreamK.take 10000 $ StreamK.unCross $ do+        x <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        y <- StreamK.mkCross (unfoldrMD nestedCount2 start)+        return $ x + y+  where+    nestedCount2 = round (fromIntegral linearCount**(1/2::Double))++o_1_space_monad :: Int -> Benchmark+o_1_space_monad value =+    bgroup "Monad"+        [ benchIO "(>>) (sqrt n x sqrt n)" $ monadThen value+        , benchIO "(>>=) (sqrt n x sqrt n)" $ toNullM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllOut)" $+            filterAllOutM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterAllIn)" $+            filterAllInM value+        , benchIO "(>>=) (sqrt n x sqrt n) (filterSome)" $+            filterSome value+        , benchIO "(>>=) (sqrt n x sqrt n) (breakAfterSome)" $+            breakAfterSome value+        , benchIO "(>>=) (cubert n x cubert n x cubert n)" $+            toNullM3 value+        ]++o_n_space_monad :: Int -> Benchmark+o_n_space_monad value =+    bgroup "Monad"+        [ benchIO "(>>=) (sqrt n x sqrt n) (toList)" $+            toListM value+        , benchIO "(>>=) (sqrt n x sqrt n) (toListSome)" $+            toListSome value+        ]++-------------------------------------------------------------------------------+-- Append+-------------------------------------------------------------------------------++{-# INLINE serial2 #-}+serial2 :: Int -> Int -> IO ()+serial2 count n =+    drain $+        StreamK.append+            (unfoldrMD count n)+            (unfoldrMD count (n + 1))++{-# INLINE serial4 #-}+serial4 :: Int -> Int -> IO ()+serial4 count n =+    drain $+    StreamK.append+        (StreamK.append+            (unfoldrMD count n)+            (unfoldrMD count (n + 1)))+        (StreamK.append+              (unfoldrMD count (n + 2))+              (unfoldrMD count (n + 3)))++o_1_space_joining :: Int -> Benchmark+o_1_space_joining value =+    bgroup "joining"+        [ benchIOSrc1 "serial (2,x/2)" (serial2 (value `div` 2))+        , benchIOSrc1 "serial (2,2,x/4)" (serial4 (value `div` 4))+        ]++-------------------------------------------------------------------------------+-- ConcatMap+-------------------------------------------------------------------------------++-- concatMap unfoldrM/unfoldrM++{-# INLINE sourceConcatMapId #-}+sourceConcatMapId :: Monad m+    => Int -> Int -> StreamK m (StreamK m Int)+sourceConcatMapId val n =+    StreamK.fromFoldable $ fmap (StreamK.fromEffect . return) [n..n+val]++{-# INLINE concatMap #-}+concatMap :: Int -> Int -> Int -> IO ()+concatMap outer inner n =+    drain $ StreamK.concatMap+        (\_ -> unfoldrMD inner n)+        (unfoldrMD outer n)++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMap+#endif++{-# INLINE concatMapPure #-}+concatMapPure :: Int -> Int -> Int -> IO ()+concatMapPure outer inner n =+    drain $ StreamK.concatMap+        (\_ -> unfoldrMD inner n)+        (unfoldrMD outer n)++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapPure [''Applicative]+#else+inspect $ hasNoTypeClasses 'concatMapPure+#endif+inspect $ 'concatMapPure `hasNoType` ''SPEC+#endif++{-# INLINE concatMapRepl #-}+concatMapRepl :: Int -> Int -> Int -> IO ()+concatMapRepl outer inner n =+    drain $ StreamK.concatMap+        (StreamK.replicate inner) (unfoldrMD outer n)++#ifdef INSPECTION+#if __GLASGOW_HASKELL__ >= 906+inspect $ hasNoTypeClassesExcept 'concatMapRepl [''Applicative]+#else+inspect $ hasNoTypeClasses 'concatMapRepl+#endif+inspect $ 'concatMapRepl `hasNoType` ''SPEC+#endif++-- concatMapWith++{-# INLINE concatStreamsWith #-}+concatStreamsWith+    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+concatStreamsWith op outer inner n =+    drain $ StreamK.concatMapWith op+        (unfoldrMD inner)+        (unfoldrMD outer n)++{-# INLINE mergeMapWith #-}+mergeMapWith+    :: (StreamK IO Int -> StreamK IO Int -> StreamK IO Int)+    -> Int+    -> Int+    -> Int+    -> IO ()+mergeMapWith op outer inner n =+    drain $ StreamK.mergeMapWith op+        (unfoldrMD inner)+        (unfoldrMD outer n)++{-# INLINE concatMapWithSerial #-}+concatMapWithSerial :: Int -> Int -> Int -> IO ()+concatMapWithSerial = concatStreamsWith StreamK.append++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapWithSerial+inspect $ 'concatMapWithSerial `hasNoType` ''SPEC+#endif++{-+{-# INLINE concatMapWithAppend #-}+concatMapWithAppend :: Int -> Int -> Int -> IO ()+concatMapWithAppend = concatStreamsWith Stream.append++#ifdef INSPECTION+inspect $ hasNoTypeClasses 'concatMapWithAppend+inspect $ 'concatMapWithAppend `hasNoType` ''SPEC+#endif+-}++-- mergeMapWith++{-# INLINE mergeMapWithSerial #-}+mergeMapWithSerial :: Int -> Int -> Int -> IO ()+mergeMapWithSerial = mergeMapWith StreamK.append++{-+{-# INLINE mergeMapWithAppend #-}+mergeMapWithAppend :: Int -> Int -> Int -> IO ()+mergeMapWithAppend = mergeMapWith Stream.append+-}++{-+-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++-- XXX Use CrossStreamK instead+instance Monad m => Applicative (StreamK.Stream m) where+    {-# INLINE pure #-}+    pure = StreamK.fromPure++    {-# INLINE (<*>) #-}+    (<*>) = StreamK.crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = StreamK.crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = StreamK.crossApplyFst++-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,+-- the monad instance of StreamD is slower than StreamK after foldr/build+-- fusion.+instance Monad m => Monad (StreamK.Stream m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip StreamK.concatMap++{-# INLINE drainApplicative #-}+drainApplicative :: Monad m => StreamK m Int -> m ()+drainApplicative s = drain $ do+    (+) <$> s <*> s++{-# INLINE drainMonad #-}+drainMonad :: Monad m => StreamK m Int -> m ()+drainMonad s = drain $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE drainMonad3 #-}+drainMonad3 :: Monad m => StreamK m Int -> m ()+drainMonad3 s = drain $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutMonad #-}+filterAllOutMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllOutMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else StreamK.nil++{-# INLINE filterAllInMonad #-}+filterAllInMonad+    :: Monad m+    => StreamK m Int -> m ()+filterAllInMonad str = drain $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else StreamK.nil+-}++-------------------------------------------------------------------------------+-- Buffering+-------------------------------------------------------------------------------++{-# INLINE reverse #-}+reverse :: MonadIO m => Int -> StreamK m Int -> m ()+reverse n = composeN n StreamK.reverse++-------------------------------------------------------------------------------+-- Reduce+-------------------------------------------------------------------------------++{-# INLINE parseBreak #-}+parseBreak :: Monad m => StreamK m Int -> m ()+parseBreak s = do+    r <- StreamK.parseDBreak Parser.one s+    case r of+         (Left _, _) -> return ()+         (Right _, s1) -> parseBreak s1++-------------------------------------------------------------------------------+-- Lift+-------------------------------------------------------------------------------++{-# INLINE iterateStateIO #-}+iterateStateIO ::+       Monad m+    => Int+    -> StateT Int m Int+iterateStateIO n = do+    x <- get+    if x > n+    then do+        put (x - 1)+        iterateStateIO n+    else return x++-- XXX This is basically testing the perf of concatEffect, change it to just+-- use concatEffect and move it along with other concatMap benchmarks.+{-# INLINE iterateStateT #-}+iterateStateT :: Int -> StreamK (StateT Int IO) Int+iterateStateT n = StreamK.concatEffect $ do+    x <- get+    if x > n+    then do+        put (x - 1)+        return $ iterateStateT n+    else return $ StreamK.fromPure x++o_n_heap_transformer :: Int -> Benchmark+o_n_heap_transformer value =+    bgroup "transformer"+        [ benchIO "StateT Int IO (n times) (baseline)" $ \n ->+            State.evalStateT (iterateStateIO n) value+        , benchIO "Stream (StateT Int IO) (n times)" $ \n ->+            State.evalStateT (drain (iterateStateT n)) value+        ]++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.StreamK.FromStream"++-- Generation of StreamK using StreamD generation functions and eleminating+-- using StreamK drain.+o_1_space_generation :: Int -> Benchmark+o_1_space_generation streamLen =+    bgroup "generation"+        [ benchFold "unfoldr" drain (unfoldrD streamLen)+        , benchFold "unfoldrM" drain (unfoldrMD streamLen)+        , benchFold "repeat" drain (repeat streamLen)+        , benchFold "repeatM" drain (repeatM streamLen)+        , benchFold "replicate" drain (replicate streamLen)+        , benchFold "replicateM" drain (replicateM streamLen)+        , benchFold "iterate" drain (iterate streamLen)+        , benchFold "iterateM" drain (iterateM streamLen)++        , benchFold "fromFoldable"  drain (fromFoldable streamLen)+        , benchFold "fromFoldableM" drain (fromFoldableM streamLen)++        , benchIOSrc "mfix_10" (mfixUnfold 10)+        , benchIOSrc "mfix_100" (mfixUnfold 100)+        , benchIOSrc "mfix_1000" (mfixUnfold 1000)++        -- appends+        , benchFold "concatMapFoldableWith"  drain (concatMapFoldableSerial streamLen)+        , benchFold "concatMapFoldableWithM" drain (concatMapFoldableSerialM streamLen)+        ]++-- Generating using StreamK and eliminating using StreamD folds.+o_1_space_elimination :: Int -> Benchmark+o_1_space_elimination streamLen =+    bgroup "elimination"+        [ benchFold "toNull" drainD (unfoldrMK streamLen)+        , benchFold "mapM_" mapM_ (unfoldrMK streamLen)+        , benchIOSink streamLen "uncons" uncons+        , benchFold "unconsD" unconsD (unfoldrMK streamLen)+        -- , benchFold "init"   init     (unfoldrM streamLen)+        , benchFold "foldl'" foldl'    (unfoldrMK streamLen)+        , benchFold "last"   last     (unfoldrMK streamLen)+        , bgroup "build"+            [+              bgroup "Identity"+                  [+                    benchIdentitySink streamLen "foldrToStreamLength"+                        (Stream.fold Fold.length . StreamK.toStream . runIdentity . foldrToStream)+                  {-+                  , benchIdentitySink 16 "foldrToStreamLength (16)"+                        (S.fold Fold.length . toStream . runIdentity . foldrToStream)+                  -}+                  ]+            ]+        ]++{-+o_1_space_nested :: Int -> Benchmark+o_1_space_nested streamLen =+    bgroup "nested"+        [ benchFold "drainApplicative" drainApplicative (unfoldrM streamLen2)+        , benchFold "drainMonad"   drainMonad   (unfoldrM streamLen2)+        , benchFold "drainMonad3"  drainMonad3  (unfoldrM streamLen3)+        , benchFold "filterAllInMonad"  filterAllInMonad  (unfoldrM streamLen2)+        , benchFold "filterAllOutMonad" filterAllOutMonad (unfoldrM streamLen2)+        , benchFold "drainApplicative (pure)" drainApplicative (unfoldr streamLen2)+        , benchFold "drainMonad (pure)"   drainMonad   (unfoldr streamLen2)+        , benchFold "drainMonad3 (pure)"  drainMonad3  (unfoldr streamLen3)+        , benchFold "filterAllInMonad (pure)"  filterAllInMonad  (unfoldr streamLen2)+        , benchFold "filterAllOutMonad (pure)" filterAllOutMonad (unfoldr streamLen2)+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen3 = round (P.fromIntegral streamLen**(1/3::P.Double)) -- triple nested loop+-}++-- Generate using StreamK and transform using StreamD transformation functions+-- and then drain using StreamK.+o_1_space_transformation :: Int -> Benchmark+o_1_space_transformation streamLen =+    bgroup "transformation"+        [ -- benchFold "foldrS" (foldrS 1) (unfoldrM streamLen)+          benchFold "scanl'"   (scanl' 1) (unfoldrMK streamLen)+        , benchFold "map"    (map  1) (unfoldrMK streamLen)+        -- , benchFold "fmap"   (fmapK 1) (unfoldrM streamLen)+        , benchFold "mapM"   (mapM 1) (unfoldrMK streamLen)+        -- , benchFold "mapMSerial"  (mapMSerial 1) (unfoldrM streamLen)+        ]++o_1_space_transformationX4 :: Int -> Benchmark+o_1_space_transformationX4 streamLen =+    bgroup "transformationX4"+        [ benchFold "scanl'"   (scanl' 4) (unfoldrMK streamLen)+        , benchFold "map"    (map  4) (unfoldrMK streamLen)+        -- , benchFold "fmap"   (fmapK 4) (unfoldrMK streamLen)+        , benchFold "mapM"   (mapM 4) (unfoldrMK streamLen)+        -- , benchFold "mapMSerial" (mapMSerial 4) (unfoldrM streamLen)+        -- XXX this is horribly slow+        -- , benchFold "concatMap" (concatMap 4) (unfoldrM streamLen16)+        ]++o_1_space_concat :: Int -> Benchmark+o_1_space_concat streamLen =+    bgroup "concat"+        [ benchIOSrc1 "concatMapPure (n of 1)"+            (concatMapPure streamLen 1)+        , benchIOSrc1 "concatMapPure (sqrt n of sqrt n)"+            (concatMapPure streamLen2 streamLen2)+        , benchIOSrc1 "concatMapPure (1 of n)"+            (concatMapPure 1 streamLen)++        , benchIOSrc1 "concatMap (n of 1)"+            (concatMap streamLen 1)+        , benchIOSrc1 "concatMap (sqrt n of sqrt n)"+            (concatMap streamLen2 streamLen2)+        , benchIOSrc1 "concatMap (1 of n)"+            (concatMap 1 streamLen)++        -- This is for comparison with foldMapWith+        , benchIOSrc "concatMapWithId (n of 1) (fromFoldable)"+            (StreamK.concatMapWith StreamK.append id . sourceConcatMapId streamLen)++        , benchIOSrc1 "concatMapWith (n of 1)"+            (concatMapWithSerial streamLen 1)+        , benchIOSrc1 "concatMapWith (sqrt n of sqrt n)"+            (concatMapWithSerial streamLen2 streamLen2)+        , benchIOSrc1 "concatMapWith (1 of n)"+            (concatMapWithSerial 1 streamLen)++        {-+        -- quadratic with number of outer streams+        , benchIOSrc1 "concatMapWithAppend (2 of n/2)"+            (concatMapWithAppend 2 (value `div` 2))+        -}++        , benchIOSrc1 "concatMapRepl (sqrt n of sqrt n)"+            (concatMapRepl streamLen2 streamLen2)++        {-+        , benchFold "sortBy" sortBy (unfoldrM streamLen)+        -}+        ]+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop++o_n_space_merge :: Int -> Benchmark+o_n_space_merge value = sqrtVal `seq`+    bgroup "concat"+        [+        -------------------mergeMapWith-----------------++        -- Use large number of streams to check scalability++          benchIOSrc1 "mergeMapWithSerial (n of 1)"+            (mergeMapWithSerial value 1)+        , benchIOSrc1 "mergeMapWithSerial (sqrtVal of sqrtVal)"+            (mergeMapWithSerial sqrtVal sqrtVal)+        , benchIOSrc1 "mergeMapWithSerial (2 of n/2)"+            (mergeMapWithSerial 2 (value `div` 2))++        {-+        , benchIOSrc1 "mergeMapWithAppend (n of 1)"+            (mergeMapWithAppend value 1)+        , benchIOSrc1 "mergeMapWithAppend (sqrtVal of sqrtVal)"+            (mergeMapWithAppend sqrtVal sqrtVal)+        -}+        ]++    where++    sqrtVal = round $ sqrt (fromIntegral value :: Double)++o_1_space_filtering :: Int -> Benchmark+o_1_space_filtering streamLen =+    bgroup "filtering"+        [ benchFold "filter-even"     (filterEven     1) (unfoldrMK streamLen)+        {-+        , benchFold "filter-all-out"  (filterAllOut streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    1) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        1) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        1) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        1) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  1) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 1) (unfoldrM streamLen)+        -}+        ]++o_1_space_filteringX4 :: Int -> Benchmark+o_1_space_filteringX4 streamLen =+    bgroup "filteringX4"+        [ benchFold "filter-even"     (filterEven     4) (unfoldrMK streamLen)+        {-+        , benchFold "filter-all-out"  (filterAllOut streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-all-in"   (filterAllIn streamLen    4) (unfoldrM streamLen)+        , benchFold "take-all"        (takeAll streamLen        4) (unfoldrM streamLen)+        , benchFold "takeWhile-true"  (takeWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "drop-one"        (dropOne        4) (unfoldrM streamLen)+        , benchFold "drop-all"        (dropAll streamLen        4) (unfoldrM streamLen)+        , benchFold "dropWhile-true"  (dropWhileTrue streamLen  4) (unfoldrM streamLen)+        , benchFold "dropWhile-false" (dropWhileFalse 4) (unfoldrM streamLen)+        -}+        ]++{-+o_1_space_zipping :: Int -> Benchmark+o_1_space_zipping streamLen =+    bgroup "zipping"+        [ benchFold "zipWith" zipWith (unfoldrM streamLen)+        , benchFold "zipWithM" zipWithM (unfoldrM streamLen)+        ]++o_1_space_mixed :: Int -> Benchmark+o_1_space_mixed streamLen =+    bgroup "mixed"+        [ benchFold "scan-map"    (scanMap    1) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    1) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   1) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   1) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   1) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   1) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 1) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 1) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 1) (unfoldrM streamLen)+        ]++o_1_space_mixedX2 :: Int -> Benchmark+o_1_space_mixedX2 streamLen =+    bgroup "mixedX2"+        [ benchFold "scan-map"    (scanMap    2) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    2) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   2) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   2) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   2) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   2) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 2) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 2) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 2) (unfoldrM streamLen)+        ]++o_1_space_mixedX4 :: Int -> Benchmark+o_1_space_mixedX4 streamLen =+    bgroup "mixedX4"+        [ benchFold "scan-map"    (scanMap    4) (unfoldrM streamLen)+        , benchFold "drop-map"    (dropMap    4) (unfoldrM streamLen)+        , benchFold "drop-scan"   (dropScan   4) (unfoldrM streamLen)+        , benchFold "take-drop"   (takeDrop streamLen   4) (unfoldrM streamLen)+        , benchFold "take-scan"   (takeScan streamLen   4) (unfoldrM streamLen)+        , benchFold "take-map"    (takeMap streamLen   4) (unfoldrM streamLen)+        , benchFold "filter-drop" (filterDrop streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-take" (filterTake streamLen 4) (unfoldrM streamLen)+        , benchFold "filter-scan" (filterScan 4) (unfoldrM streamLen)+        , benchFold "filter-map"  (filterMap streamLen 4) (unfoldrM streamLen)+        ]+-}++o_1_space_grouping :: Int -> Benchmark+o_1_space_grouping value =+    bgroup "grouping"+        [+          benchIOSink value "parseBreak (recursive)" parseBreak+        ]++o_1_space :: Int -> Benchmark+o_1_space streamLen =+    bgroup (o_1_space_prefix moduleName)+      [ o_1_space_generation streamLen+      , o_1_space_elimination streamLen+      -- , o_1_space_nested streamLen+      , o_1_space_joining streamLen+      , o_1_space_mapping streamLen+      , o_1_space_transformation streamLen+      , o_1_space_transformationX4 streamLen+      , o_1_space_concat streamLen+      , o_1_space_applicative streamLen+      , o_1_space_monad streamLen+      , o_1_space_filtering streamLen+      , o_1_space_filteringX4 streamLen+      , o_1_space_grouping streamLen+      -- , o_1_space_zipping streamLen+      -- , o_1_space_mixed streamLen+      -- , o_1_space_mixedX2 streamLen+      -- , o_1_space_mixedX4 streamLen+      -- , o_1_space_list streamLen+      ]++o_n_heap :: Int -> Benchmark+o_n_heap streamLen =+    bgroup (o_n_heap_prefix moduleName)+      [ {- bgroup "transformation"+        [ benchFold "foldlS" (foldlS 1) (unfoldrM streamLen)+        ] -}+        bgroup "buffered" [benchIOSink streamLen "reverse" (reverse 1)]+      , o_n_heap_transformer streamLen+      ]++o_n_stack :: Int -> Benchmark+o_n_stack streamLen =+    bgroup (o_n_stack_prefix moduleName)+      [+      {-+      , bgroup "transformation"+        [+          -- XXX why do these need so much stack+          benchFold "intersperse" (intersperse streamLen 1) (unfoldrM streamLen2)+        , benchFold "interspersePure" (intersperse streamLen 1) (unfoldr streamLen2)+        ]+      , bgroup "transformationX4"+        [+          benchFold "intersperse" (intersperse streamLen 4) (unfoldrM streamLen16)+        ]+        -}+          o_n_stack_iterated streamLen+        ]+      {-+    where+    streamLen2 = round (P.fromIntegral streamLen**(1/2::P.Double)) -- double nested loop+    streamLen16 = round (P.fromIntegral streamLen**(1/16::P.Double)) -- triple nested loop+    -}++o_n_space :: Int -> Benchmark+o_n_space streamLen =+    bgroup (o_n_space_prefix moduleName)+      [ bgroup "elimination"+        [ benchFold "toList" toList (unfoldrMK streamLen)+        ]+      , o_n_space_merge streamLen+      , o_n_space_monad streamLen+      , o_n_space_iterated streamLen+      , o_n_space_applicative streamLen+      , o_n_space_traversable streamLen+      ]++main :: IO ()+main =+    defaultMain+        [ o_1_space streamLen+        , o_n_stack streamLen+        , o_n_heap streamLen+        , o_n_space streamLen+        ]++    where++    streamLen = 100000
+ benchmark/Streamly/Benchmark/Data/StreamK/StreamKAlt.hs view
@@ -0,0 +1,454 @@++-- |+-- Module      : Streamly.Benchmark.Data.Stream.StreamDK+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Main (main) where++-- import Control.Monad (when)+-- import Data.Maybe (isJust)+import Prelude hiding ()+-- import qualified Prelude as P+-- import qualified Data.List as List++import qualified Streamly.Internal.Data.StreamK.Alt as S+-- import qualified Streamly.Internal.Data.Stream.Common as SP+-- import qualified Streamly.Internal.Data.SVar as S++import Streamly.Benchmark.Common+import Test.Tasty.Bench (bgroup, Benchmark, defaultMain)++value :: Int+value = 100000+{-+value2, value3, value16, maxValue :: Int+value2 = round (P.fromIntegral value**(1/2::P.Double)) -- double nested loop+value3 = round (P.fromIntegral value**(1/3::P.Double)) -- triple nested loop+value16 = round (P.fromIntegral value**(1/16::P.Double)) -- triple nested loop+maxValue = value+-}++-------------------------------------------------------------------------------+-- Benchmark ops+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Stream generation and elimination+-------------------------------------------------------------------------------++type Stream m a = S.Stream m a++{-# INLINE sourceUnfoldr #-}+sourceUnfoldr :: Monad m => Int -> Stream m Int+sourceUnfoldr n = S.unfoldr step n+    where+    step cnt =+        if cnt > n + value+        then Nothing+        else Just (cnt, cnt + 1)++{-+{-# INLINE sourceUnfoldrN #-}+sourceUnfoldrN :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrN m n = S.unfoldr step n+    where+    step cnt =+        if cnt > n + m+        then Nothing+        else Just (cnt, cnt + 1)+-}++{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Stream m Int+sourceUnfoldrM n = S.unfoldrM step n+    where+    step cnt =+        if cnt > n + value+        then return Nothing+        else return (Just (cnt, cnt + 1))++{-+{-# INLINE sourceUnfoldrMN #-}+sourceUnfoldrMN :: Monad m => Int -> Int -> Stream m Int+sourceUnfoldrMN m n = S.unfoldrM step n+    where+    step cnt =+        if cnt > n + m+        then return Nothing+        else return (Just (cnt, cnt + 1))+-}++{-+{-# INLINE sourceFromEnum #-}+sourceFromEnum :: Monad m => Int -> Stream m Int+sourceFromEnum n = S.enumFromStepN n 1 value+-}++{-+{-# INLINE sourceFromFoldable #-}+sourceFromFoldable :: Int -> Stream m Int+sourceFromFoldable n = S.fromFoldable [n..n+value]+-}++{-+{-# INLINE sourceFromFoldableM #-}+sourceFromFoldableM :: S.MonadAsync m => Int -> Stream m Int+sourceFromFoldableM n = S.fromFoldableM (Prelude.fmap return [n..n+value])+-}++{-+{-# INLINE sourceFoldMapWith #-}+sourceFoldMapWith :: Int -> Stream m Int+sourceFoldMapWith n = SP.foldMapWith S.serial S.fromPure [n..n+value]++{-# INLINE sourceFoldMapWithM #-}+sourceFoldMapWithM :: Monad m => Int -> Stream m Int+sourceFoldMapWithM n = SP.foldMapWith S.serial (S.fromEffect . return) [n..n+value]+-}++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++{-# INLINE runStream #-}+runStream :: Monad m => Stream m a -> m ()+runStream = S.drain+-- runStream = S.mapM_ (\_ -> return ())++{-+{-# INLINE mapM_ #-}+mapM_ :: Monad m => Stream m a -> m ()+mapM_ = S.mapM_ (\_ -> return ())+-}++{-# INLINE toNull #-}+toNull :: Monad m => Stream m Int -> m ()+toNull = runStream++{-# INLINE uncons #-}+uncons :: Monad m => Stream m Int -> m ()+uncons s = do+    r <- S.uncons s+    case r of+        Nothing -> return ()+        Just (_, t) -> uncons t++{-+{-# INLINE init #-}+init :: (Monad m, S.IsStream t) => t m a -> m ()+init s = do+    t <- S.init s+    P.mapM_ S.drain t++{-# INLINE tail #-}+tail :: (Monad m, S.IsStream t) => t m a -> m ()+tail s = S.tail s >>= P.mapM_ tail++{-# INLINE nullTail #-}+{-# INLINE headTail #-}+{-# INLINE zip #-}+nullTail, headTail, zip+    :: Monad m+    => Stream m Int -> m ()++nullTail s = do+    r <- S.null s+    when (not r) $ S.tail s >>= P.mapM_ nullTail++headTail s = do+    h <- S.head s+    when (isJust h) $ S.tail s >>= P.mapM_ headTail++{-# INLINE toList #-}+toList :: Monad m => Stream m Int -> m [Int]+toList = S.toList++{-# INLINE foldl #-}+foldl :: Monad m => Stream m Int -> m Int+foldl  = S.foldl' (+) 0++{-# INLINE last #-}+last :: Monad m => Stream m Int -> m (Maybe Int)+last   = S.last+-}++-------------------------------------------------------------------------------+-- Transformation+-------------------------------------------------------------------------------++{-+{-# INLINE transform #-}+transform :: Monad m => Stream m a -> m ()+transform = runStream++{-# INLINE composeN #-}+composeN+    :: Monad m+    => Int -> (Stream m Int -> Stream m Int) -> Stream m Int -> m ()+composeN n f =+    case n of+        1 -> transform . f+        2 -> transform . f . f+        3 -> transform . f . f . f+        4 -> transform . f . f . f . f+        _ -> undefined+-}++{-+{-# INLINE scan #-}+{-# INLINE map #-}+{-# INLINE fmap #-}+{-# INLINE filterEven #-}+{-# INLINE filterAllOut #-}+{-# INLINE filterAllIn #-}+{-# INLINE takeOne #-}+{-# INLINE takeAll #-}+{-# INLINE takeWhileTrue #-}+{-# INLINE dropOne #-}+{-# INLINE dropAll #-}+{-# INLINE dropWhileTrue #-}+{-# INLINE dropWhileFalse #-}+{-# INLINE foldlS #-}+{-# INLINE concatMap #-}+scan, map, fmap, filterEven, filterAllOut,+    filterAllIn, takeOne, takeAll, takeWhileTrue, dropAll, dropOne,+    dropWhileTrue, dropWhileFalse, foldlS, concatMap+    :: Monad m+    => Int -> Stream m Int -> m ()++{-# INLINE mapM #-}+{-# INLINE mapMSerial #-}+{-# INLINE intersperse #-}+mapM, mapMSerial, intersperse+    :: S.MonadAsync m => Int -> Stream m Int -> m ()++scan           n = composeN n $ S.scanl' (+) 0+map            n = composeN n $ P.fmap (+1)+fmap           n = composeN n $ P.fmap (+1)+mapM           n = composeN n $ S.mapM return+mapMSerial     n = composeN n $ S.mapMSerial return+filterEven     n = composeN n $ S.filter even+filterAllOut   n = composeN n $ S.filter (> maxValue)+filterAllIn    n = composeN n $ S.filter (<= maxValue)+takeOne        n = composeN n $ S.take 1+takeAll        n = composeN n $ S.take maxValue+takeWhileTrue  n = composeN n $ S.takeWhile (<= maxValue)+dropOne        n = composeN n $ S.drop 1+dropAll        n = composeN n $ S.drop maxValue+dropWhileTrue  n = composeN n $ S.dropWhile (<= maxValue)+dropWhileFalse n = composeN n $ S.dropWhile (<= 1)+foldlS         n = composeN n $ S.foldlS (flip S.cons) S.nil+-- We use a (sqrt n) element stream as source and then concat the same stream+-- for each element to produce an n element stream.+concatMap      n = composeN n $ (\s -> S.concatMap (\_ -> s) s)+intersperse    n = composeN n $ S.intersperse maxValue++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++iterStreamLen, maxIters :: Int+iterStreamLen = 10+maxIters = 10000++{-# INLINE iterateSource #-}+iterateSource+    :: S.MonadAsync m+    => (Stream m Int -> Stream m Int) -> Int -> Int -> Stream m Int+iterateSource g i n = f i (sourceUnfoldrMN iterStreamLen n)+    where+        f (0 :: Int) m = g m+        f x m = g (f (x P.- 1) m)++{-# INLINE iterateMapM #-}+{-# INLINE iterateScan #-}+{-# INLINE iterateFilterEven #-}+{-# INLINE iterateTakeAll #-}+{-# INLINE iterateDropOne #-}+{-# INLINE iterateDropWhileFalse #-}+{-# INLINE iterateDropWhileTrue #-}+iterateMapM, iterateScan, iterateFilterEven, iterateTakeAll, iterateDropOne,+    iterateDropWhileFalse, iterateDropWhileTrue+    :: S.MonadAsync m+    => Int -> Stream m Int++-- this is quadratic+iterateScan            = iterateSource (S.scanl' (+) 0) (maxIters `div` 10)+iterateDropWhileFalse  = iterateSource (S.dropWhile (> maxValue))+                                       (maxIters `div` 10)++iterateMapM            = iterateSource (S.mapM return) maxIters+iterateFilterEven      = iterateSource (S.filter even) maxIters+iterateTakeAll         = iterateSource (S.take maxValue) maxIters+iterateDropOne         = iterateSource (S.drop 1) maxIters+iterateDropWhileTrue   = iterateSource (S.dropWhile (<= maxValue)) maxIters++-------------------------------------------------------------------------------+-- Zipping and concat+-------------------------------------------------------------------------------++zip src       = transform $ S.zipWith (,) src src++{-# INLINE concatMapRepl4xN #-}+concatMapRepl4xN :: Monad m => Stream m Int -> m ()+concatMapRepl4xN src = transform $ (S.concatMap (S.replicate 4) src)++-------------------------------------------------------------------------------+-- Mixed Composition+-------------------------------------------------------------------------------++{-# INLINE scanMap #-}+{-# INLINE dropMap #-}+{-# INLINE dropScan #-}+{-# INLINE takeDrop #-}+{-# INLINE takeScan #-}+{-# INLINE takeMap #-}+{-# INLINE filterDrop #-}+{-# INLINE filterTake #-}+{-# INLINE filterScan #-}+{-# INLINE filterMap #-}+scanMap, dropMap, dropScan, takeDrop, takeScan, takeMap, filterDrop,+    filterTake, filterScan, filterMap+    :: Monad m => Int -> Stream m Int -> m ()++scanMap    n = composeN n $ S.map (subtract 1) . S.scanl' (+) 0+dropMap    n = composeN n $ S.map (subtract 1) . S.drop 1+dropScan   n = composeN n $ S.scanl' (+) 0 . S.drop 1+takeDrop   n = composeN n $ S.drop 1 . S.take maxValue+takeScan   n = composeN n $ S.scanl' (+) 0 . S.take maxValue+takeMap    n = composeN n $ S.map (subtract 1) . S.take maxValue+filterDrop n = composeN n $ S.drop 1 . S.filter (<= maxValue)+filterTake n = composeN n $ S.take maxValue . S.filter (<= maxValue)+filterScan n = composeN n $ S.scanl' (+) 0 . S.filter (<= maxBound)+filterMap  n = composeN n $ S.map (subtract 1) . S.filter (<= maxValue)++-------------------------------------------------------------------------------+-- Nested Composition+-------------------------------------------------------------------------------++{-# INLINE toNullApNested #-}+toNullApNested :: Monad m => Stream m Int -> m ()+toNullApNested s = runStream $ do+    (+) <$> s <*> s++{-# INLINE toNullNested #-}+toNullNested :: Monad m => Stream m Int -> m ()+toNullNested s = runStream $ do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNested3 #-}+toNullNested3 :: Monad m => Stream m Int -> m ()+toNullNested3 s = runStream $ do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNested #-}+filterAllOutNested+    :: Monad m+    => Stream m Int -> m ()+filterAllOutNested str = runStream $ do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else S.nil++{-# INLINE filterAllInNested #-}+filterAllInNested+    :: Monad m+    => Stream m Int -> m ()+filterAllInNested str = runStream $ do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else S.nil++-------------------------------------------------------------------------------+-- Nested Composition Pure lists+-------------------------------------------------------------------------------++{-# INLINE sourceUnfoldrList #-}+sourceUnfoldrList :: Int -> Int -> [Int]+sourceUnfoldrList maxval n = List.unfoldr step n+    where+    step cnt =+        if cnt > n + maxval+        then Nothing+        else Just (cnt, cnt + 1)++{-# INLINE toNullApNestedList #-}+toNullApNestedList :: [Int] -> [Int]+toNullApNestedList s = (+) <$> s <*> s++{-# INLINE toNullNestedList #-}+toNullNestedList :: [Int] -> [Int]+toNullNestedList s = do+    x <- s+    y <- s+    return $ x + y++{-# INLINE toNullNestedList3 #-}+toNullNestedList3 :: [Int] -> [Int]+toNullNestedList3 s = do+    x <- s+    y <- s+    z <- s+    return $ x + y + z++{-# INLINE filterAllOutNestedList #-}+filterAllOutNestedList :: [Int] -> [Int]+filterAllOutNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s < 0+    then return s+    else []++{-# INLINE filterAllInNestedList #-}+filterAllInNestedList :: [Int] -> [Int]+filterAllInNestedList str = do+    x <- str+    y <- str+    let s = x + y+    if s > 0+    then return s+    else []+-}++-------------------------------------------------------------------------------+-- Benchmarks+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Stream.StreamDK"++o_1_space :: [Benchmark]+o_1_space =+    [ bgroup (o_1_space_prefix moduleName)+      [ bgroup "generation"+        [ benchFold "unfoldr"       toNull sourceUnfoldr+        , benchFold "unfoldrM"      toNull sourceUnfoldrM+        ]+      , bgroup "elimination"+        [ benchFold "toNull"   toNull   sourceUnfoldrM+        , benchFold "uncons"   uncons   sourceUnfoldrM+        ]+      ]+    ]++main :: IO ()+main = defaultMain [o_1_space]
benchmark/Streamly/Benchmark/Data/Unfold.hs view
@@ -31,7 +31,9 @@ import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Unfold as UF+#ifndef USE_STREAMLY_CORE import qualified Streamly.Internal.Data.Unfold.Prelude as UF+#endif import qualified Streamly.Internal.Data.Stream as S import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.StreamK as K@@ -118,7 +120,7 @@ {-# INLINE both #-} both :: Monad m => Int -> Int -> m () both size start =-    drainTransformationDefault (size + start) (UF.both start) undefined+    drainTransformationDefault (size + start) (UF.supply start) ()   {-# INLINE first #-}@@ -201,9 +203,9 @@ _const size start =     drainGeneration (UF.take size (UF.fromEffect (return start))) undefined -{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => Int -> Int -> m ()-unfoldrM size start = drainGeneration (UF.unfoldrM step) start+{-# INLINE sourceUnfoldrM #-}+sourceUnfoldrM :: Monad m => Int -> Int -> Unfold m Int Int+sourceUnfoldrM size start = UF.unfoldrM step      where @@ -213,6 +215,10 @@               then Just (i, i + 1)               else Nothing +{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => Int -> Int -> m ()+unfoldrM size start = drainGeneration (sourceUnfoldrM size start) start+ {-# INLINE fromList #-} fromList :: Monad m => Int -> Int -> m () fromList size start = drainGeneration UF.fromList [start .. start + size]@@ -310,7 +316,7 @@ mapM2 size start =     drainTransformationDefault         size-        (UF.mapM2 (\a b -> return $ a + b))+        (UF.mapM (\(a, b) -> return $ a + b) . UF.carry)         start  -------------------------------------------------------------------------------@@ -427,7 +433,7 @@     let end = start + nthRoot 2 value         s = source end     -- in UF.fold ((+) <$> s <*> s) FL.drain start-    in UF.fold FL.drain ((+) `fmap` s `UF.crossApply` s) start+    in UF.fold FL.drain (((+) `fmap` s) `UF.crossApply` s) start  {-# INLINE _apDiscardFst #-} _apDiscardFst :: Int -> Int -> m ()@@ -441,16 +447,17 @@ -- Monad ------------------------------------------------------------------------------- +-- XXX to keep the benchmarks same as Stream we should use sourceUnfoldrM in+-- all of these, and other benchmarks too. {-# INLINE concatMapM #-}-concatMapM :: Monad m => Int -> Int -> m ()-concatMapM value start =-    val `seq` drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start+concatMapM :: Monad m => Int -> Int -> Int -> m ()+concatMapM inner outer start =+    drainGeneration (UF.concatMapM unfoldInGen unfoldOut) start      where -    val = nthRoot 2 value-    unfoldInGen i = return (UF.second (i + val) UF.enumerateFromToIntegral)-    unfoldOut = UF.second (start + val) UF.enumerateFromToIntegral+    unfoldInGen i = return (UF.second (i + inner) UF.enumerateFromToIntegral)+    unfoldOut = UF.second (start + outer) UF.enumerateFromToIntegral  {-# INLINE toNull #-} toNull :: Monad m => Int -> Int -> m ()@@ -483,7 +490,8 @@         -}         u = src `UF.bind` \x ->             src `UF.bind` \y ->-                UF.fromPure (x + y)+            src `UF.bind` \z ->+                UF.fromPure (x + y + z)      in UF.fold FL.drain u start  {-# INLINE toList #-}@@ -596,16 +604,13 @@ -- Benchmark ops ------------------------------------------------------------------------------- --- n * (n + 1) / 2 == linearCount-concatCount :: Int -> Int-concatCount linearCount =-    round (((1 + 8 * fromIntegral linearCount)**(1/2::Double) - 1) / 2)--{-# INLINE many #-}-many :: Monad m => Int -> Int -> m ()-many linearCount start = do-    let end = start + concatCount linearCount-    UF.fold FL.drain (UF.many (source end) (source end)) start+{-# INLINE unfoldEach #-}+unfoldEach :: Monad m => Int -> Int -> Int -> m ()+unfoldEach inner outer start = do+    UF.fold+        FL.drain+        (UF.unfoldEach (sourceUnfoldrM inner start) (sourceUnfoldrM outer start))+        start  ------------------------------------------------------------------------------- -- Benchmarks@@ -715,31 +720,37 @@ o_1_space_nested env size =     [ bgroup           "nested"-          [ benchIO "(<*>) (sqrt n x sqrt n)" $ toNullAp size+          [ benchIO "crossApply outer=inner=(sqrt Max)" $ toNullAp size           -- Unimplemented           -- , benchIO "apDiscardFst" $ apDiscardFst size           -- , benchIO "apDiscardSnd" $ apDiscardSnd size -          , benchIO "concatMapM (sqrt n x sqrt n)" $ concatMapM size-          , benchIO "(>>=) (sqrt n x sqrt n)" $ toNull size-          , benchIO "(>>=) (cubert n x cubert n x cubert n)" $ toNull3 size-          , benchIO "breakAfterSome" $ breakAfterSome size-          , benchIO "filterAllOut" $ filterAllOut size-          , benchIO "filterAllIn" $ filterAllIn size-          , benchIO "filterSome" $ filterSome size+          , benchIO "concatMapM outer=inner=(sqrt Max)" $ concatMapM sqrtVal sqrtVal+          , benchIO "bind2" $ toNull size+          , benchIO "bind3" $ toNull3 size+          , benchIO "breakAfterSome2" $ breakAfterSome size+          , benchIO "filterAllOut2" $ filterAllOut size+          , benchIO "filterAllIn2" $ filterAllIn size+          , benchIO "filterSome2" $ filterSome size -          , benchIO "many" $ many size+          , benchIO "unfoldEach inner=outer=(sqrt Max)" $ unfoldEach sqrtVal sqrtVal+          , benchIO "unfoldEach inner=1 outer=Max" $ unfoldEach 1 size+          , benchIO "unfoldEach inner=Max outer=1" $ unfoldEach size 1           , mkBench "foldMany (Fold.takeEndBy_ (== lf) Fold.drain)" env             $ \inh _ -> foldManySepBy inh           ]     ] +    where++    sqrtVal = round $ sqrt (fromIntegral size :: Double)+ o_n_space_nested :: Int -> [Benchmark] o_n_space_nested size =     [ bgroup           "nested"-          [ benchIO "toList" $ toList size-          , benchIO "toListSome" $ toListSome size+          [ benchIO "toList2" $ toList size+          , benchIO "toListSome2" $ toListSome size           ]     ] @@ -785,10 +796,12 @@ -- inspect $ 'readWriteFinallyUnfold `hasNoType` ''Step #endif +#ifndef USE_STREAMLY_CORE readWriteFinallyUnfold :: Handle -> Handle -> IO () readWriteFinallyUnfold inh devNull =     let readEx = UF.finally (\_ -> hClose inh) FH.reader     in S.fold (FH.write devNull) $ S.unfold readEx inh+#endif  -- | Send the file contents to /dev/null with exception handling readWriteBracket_Unfold :: Handle -> Handle -> IO ()@@ -805,10 +818,12 @@ -- inspect $ 'readWriteBracketUnfold `hasNoType` ''Step #endif +#ifndef USE_STREAMLY_CORE readWriteBracketUnfold :: Handle -> Handle -> IO () readWriteBracketUnfold inh devNull =     let readEx = UF.bracket return (\_ -> hClose inh) FH.reader     in S.fold (FH.write devNull) $ S.unfold readEx inh+#endif  o_1_space_copy_read_exceptions :: BenchEnv -> [Benchmark] o_1_space_copy_read_exceptions env =@@ -819,12 +834,14 @@            readWriteHandleExceptionUnfold inh (nullH env)        , mkBenchSmall "UF.finally_" env $ \inh _ ->            readWriteFinally_Unfold inh (nullH env)-       , mkBenchSmall "UF.finally" env $ \inh _ ->-           readWriteFinallyUnfold inh (nullH env)        , mkBenchSmall "UF.bracket_" env $ \inh _ ->            readWriteBracket_Unfold inh (nullH env)+#ifndef USE_STREAMLY_CORE+       , mkBenchSmall "UF.finally" env $ \inh _ ->+           readWriteFinallyUnfold inh (nullH env)        , mkBenchSmall "UF.bracket" env $ \inh _ ->            readWriteBracketUnfold inh (nullH env)+#endif         ]     ]
+ benchmark/Streamly/Benchmark/FileSystem/DirIO.hs view
@@ -0,0 +1,93 @@+-- |+-- Module      : Streamly.Benchmark.FileSystem.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}++module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (void)+import GHC.IO.Encoding (setLocaleEncoding, utf8)+import Streamly.Benchmark.Common (o_1_space_prefix)++import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Fold as Fold++import Prelude hiding (last, length)+import Test.Tasty.Bench+import BenchTestLib.DirIO++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "FileSystem.DirIO"++-- | List the current directory recursively+main :: IO ()+main = do+    setLocaleEncoding utf8++    let smallTree = "benchmark-tmp/dir-structure-small"+        bigTree = "benchmark-tmp/dir-structure-big"+    void $ createDirStucture smallTree 2 3+    void $ createDirStucture bigTree 5 5++    defaultMain+        [ bgroup (o_1_space_prefix moduleName)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+           $ bench "listDirByteChunked (big)" (nfIO $+               Stream.fold Fold.drain $ listDirByteChunked bigTree) :+#endif+            -- NOTE: The BFS traversal fails with:+            -- openDirStream: resource exhausted (Too many open files)+            -- if a bigger directory tree is used+            [ bench "listDirUnfoldDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldDfs id bigTree+            , bench "listDirUnfoldBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldBfs id smallTree+            , bench "listDirUnfoldBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirUnfoldBfsRev id smallTree+            , bench "listDirConcatDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatDfs id bigTree+            , bench "listDirConcatBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatBfs id smallTree+            , bench "listDirConcatBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirConcatBfsRev id smallTree+            , bench "listDirAppend (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirAppend id bigTree+            , bench "listDirInterleave (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirInterleave id bigTree+            , bench "listDirPar (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirPar id bigTree+            , bench "listDirParInterleaved (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirParInterleaved id bigTree+            , bench "listDirParOrdered (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirParOrdered id bigTree+            , bench "listDirChunkDfs (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkDfs id bigTree+            , bench "listDirChunkBfs (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkBfs id smallTree+            , bench "listDirChunkBfsRev (small)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkBfsRev id smallTree+            , bench "listDirChunkAppend (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkAppend id bigTree+            , bench "listDirChunkInterleave (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkInterleave id bigTree+            , bench "listDirChunkPar (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkPar id bigTree+            , bench "listDirChunkParInterleaved (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkParInterleaved id bigTree+            , bench "listDirChunkParOrdered (big)" $ nfIO $+                  Stream.fold Fold.drain $ listDirChunkParOrdered id bigTree+            ]+        ]
benchmark/Streamly/Benchmark/FileSystem/Handle/Read.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Benchmark.FileSystem.Handle@@ -29,7 +28,6 @@ import GHC.Magic (noinline) import System.IO (Handle) -import qualified Streamly.Data.Stream as Stream import qualified Streamly.Data.Fold as Fold import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Internal.Data.Array as A@@ -62,7 +60,7 @@  -- | Get the last byte from a file bytestream. readLast :: Handle -> IO (Maybe Word8)-readLast = S.fold Fold.last . S.unfold FH.reader+readLast = S.fold Fold.latest . S.unfold FH.reader  #ifdef INSPECTION inspect $ hasNoTypeClasses 'readLast@@ -192,7 +190,7 @@         $ IUS.lines FL.drain         $ SS.decodeLatin1         -- XXX replace with toBytes-        $ S.unfoldMany A.reader (IFH.readChunks inh)+        $ S.unfoldEach A.reader (IFH.readChunks inh)  #ifdef INSPECTION inspect $ hasNoTypeClasses 'getChunksConcatUnfoldCountLines@@ -216,8 +214,8 @@ chunksOfSum n inh =     S.fold Fold.length $ IP.groupsOf n FL.sum (S.unfold FH.reader inh) -foldManyPostChunksOfSum :: Int -> Handle -> IO Int-foldManyPostChunksOfSum n inh =+foldMany1ChunksOfSum :: Int -> Handle -> IO Int+foldMany1ChunksOfSum n inh =     S.fold Fold.length         $ IP.foldManyPost (FL.take n FL.sum) (S.unfold FH.reader inh) @@ -235,7 +233,7 @@ groupsOf n inh =     -- writeNUnsafe gives 2.5x boost here over writeN.     S.fold Fold.length-        $ IP.groupsOf n (A.writeNUnsafe n) (S.unfold FH.reader inh)+        $ IP.groupsOf n (A.unsafeCreateOf n) (S.unfold FH.reader inh)  #ifdef INSPECTION inspect $ hasNoTypeClasses 'groupsOf@@ -249,7 +247,7 @@ {-# INLINE chunksOf #-} chunksOf :: Int -> Handle -> IO Int chunksOf n inh =-    S.fold Fold.length $ Stream.chunksOf n (S.unfold FH.reader inh)+    S.fold Fold.length $ A.chunksOf n (S.unfold FH.reader inh)  o_1_space_reduce_read_grouped :: BenchEnv -> [Benchmark] o_1_space_reduce_read_grouped env =@@ -263,13 +261,13 @@         -- XXX investigate why we need inline/noinline in these cases (GHC)         -- Chunk using parsers         , mkBench-            ("S.foldManyPost (FL.take " ++ show (bigSize env) ++ " FL.sum)")+            ("S.foldMany1 (FL.take " ++ show (bigSize env) ++ " FL.sum)")             env-            $ \inh _ -> noinline foldManyPostChunksOfSum (bigSize env) inh+            $ \inh _ -> noinline foldMany1ChunksOfSum (bigSize env) inh         , mkBench-            "S.foldManyPost (FL.take 1 FL.sum)"+            "S.foldMany1 (FL.take 1 FL.sum)"             env-            $ \inh _ -> inline foldManyPostChunksOfSum 1 inh+            $ \inh _ -> inline foldMany1ChunksOfSum 1 inh         , mkBench             ("S.foldMany (FL.take " ++ show (bigSize env) ++ " FL.sum)")             env@@ -288,11 +286,11 @@             groupsOf 1000 inh          -- chunksOf may use a different impl than groupsOf-        , mkBenchSmall "S.chunksOf 1" env $ \inh _ ->+        , mkBenchSmall "A.chunksOf 1" env $ \inh _ ->             chunksOf 1 inh-        , mkBench "S.chunksOf 10" env $ \inh _ ->+        , mkBench "A.chunksOf 10" env $ \inh _ ->             chunksOf 10 inh-        , mkBench "S.chunksOf 1000" env $ \inh _ ->+        , mkBench "A.chunksOf 1000" env $ \inh _ ->             chunksOf 1000 inh         ]     ]
benchmark/Streamly/Benchmark/FileSystem/Handle/ReadWrite.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Benchmark.FileSystem.Handle@@ -135,7 +134,7 @@     where      fld = FH.write devNull-    unf = IUF.many A.reader FH.chunkReader+    unf = IUF.unfoldEach A.reader FH.chunkReader  -- | Send the chunk content to /dev/null -- Implicitly benchmarked via 'readWithFromBytesNull'@@ -145,7 +144,7 @@     where      fld = FH.write devNull-    unf = IUF.many A.reader FH.chunkReaderWith+    unf = IUF.unfoldEach A.reader FH.chunkReaderWith  o_1_space_copy_fromBytes :: BenchEnv -> [Benchmark] o_1_space_copy_fromBytes env =
benchmark/Streamly/Benchmark/Unicode/Stream.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- -- Module      : Streamly.Unicode.Stream@@ -29,6 +28,7 @@ import Streamly.Data.Fold (Fold) import Prelude hiding (last, length) import System.IO (Handle)+import Streamly.Internal.System.IO (arrayPayloadSize)  import qualified Streamly.Data.Array as Array import qualified Streamly.Data.Fold as Fold@@ -37,6 +37,7 @@ import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Unicode.Array as UnicodeArr import qualified Streamly.Internal.Unicode.Stream as Unicode+import qualified Streamly.Internal.Data.Array as Array  import Test.Tasty.Bench hiding (env) import Streamly.Benchmark.Common@@ -45,7 +46,6 @@ #ifdef INSPECTION import Streamly.Internal.Data.MutByteArray (Unbox) import Streamly.Internal.Data.Stream (Step(..))-import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.MutArray as MutArray import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Tuple.Strict as Strict@@ -103,8 +103,8 @@ linesUnlinesArrayWord8Copy :: Handle -> Handle -> IO () linesUnlinesArrayWord8Copy inh outh =     Stream.fold (Handle.write outh)-      $ Stream.interposeSuffix 10 Array.reader-      $ splitOnSuffix (== 10) Array.write+      $ Stream.unfoldEachEndBy 10 Array.reader+      $ splitOnSuffix (== 10) Array.create       $ Stream.unfold Handle.reader inh  -- XXX splitSuffixOn requires -funfolding-use-threshold=150 for better fusion@@ -143,7 +143,7 @@ wordsUnwordsCopyWord8 :: Handle -> Handle -> IO () wordsUnwordsCopyWord8 inh outh =     Stream.fold (Handle.write outh)-        $ Stream.interposeSuffix 32 Unfold.fromList+        $ Stream.unfoldEachEndBy 32 Unfold.fromList         $ Stream.wordsBy isSp Fold.toList         $ Stream.unfold Handle.reader inh @@ -258,6 +258,17 @@      $ Unicode.decodeUtf8'      $ Stream.unfold Handle.reader inh +-- | Copy file+{-# NOINLINE copyStreamUtf16 #-}+copyStreamUtf16 :: Handle -> Handle -> IO ()+copyStreamUtf16 inh outh =+   Stream.fold (Handle.writeChunks outh)+     $ fmap Array.unsafeCast $ Array.chunksOf (arrayPayloadSize (16 * 1024))+     $ Unicode.encodeUtf16le'+     $ Unicode.decodeUtf16le+     $ Array.concat $ fmap Array.unsafeCast $ Unicode.mkEvenW8Chunks+     $ Handle.readChunks inh+ #ifdef INSPECTION inspect $ hasNoTypeClasses '_copyStreamUtf8' -- inspect $ '_copyStreamUtf8 `hasNoType` ''Step@@ -319,6 +330,8 @@               $ \inh outh -> _copyStreamUtf8Parser inh outh         , mkBenchSmall "encodeUtf8 . decodeUtf8" env $ \inh outh ->             copyStreamUtf8 inh outh+        , mkBenchSmall "encodeUtf16 . decodeUtf16" env $ \inh outh ->+            copyStreamUtf16 inh outh         ]     ]
benchmark/bench-runner/Main.hs view
@@ -60,29 +60,15 @@         | "Prelude.WAsync/o-n-space.monad-outer-product." `isPrefixOf` benchName =             "-K4M" -        -- This module is dev only now, and can be removed at some point-        | "Data.Stream.StreamDK/o-1-space.grouping.classifySessionsOf"-            `isPrefixOf` benchName = "-K512K"-        | "Data.Stream.StreamDK/o-n-space.foldr.foldrM/"-            `isPrefixOf` benchName = "-K4M"-        | "Data.Stream.StreamDK/o-n-space.iterated."-            `isPrefixOf` benchName = "-K4M -M64M"-        -- GHC 9.4.4 requires 4M-        | "Data.Stream.StreamDK/o-n-space.traversable."-            `isPrefixOf` benchName = "-K4M"-        -- GHC-9.6 requires 64M, earlier it was 32M-        | "Data.Stream.StreamDK/o-n-heap.buffered.readsPrec pure streams" == benchName =-            "-M64M"-        -- GHC-9.6 requires 64M, earlier it was 32M-        | "Data.Stream.StreamDK/o-n-heap.buffered.showPrec Haskell lists" == benchName =-            "-M64M"-         -----------------------------------------------------------------------          | "Data.StreamD/o-n-space.elimination.toList" == benchName =             "-K2M"         | "Data.StreamK/o-n-space.elimination.toList" == benchName =             "-K2M"+        -- XXX Memory required for these has increased in streamly-core 0.3+        | "Data.StreamK/o-1-space.list.nested" `isPrefixOf` benchName =+            "-M640M"          ----------------------------------------------------------------------- @@ -101,7 +87,7 @@             "-M64M"          | "Data.Stream.ConcurrentEager/o-n-heap.monad-outer-product.toNullAp"-            `isPrefixOf` benchName = "-M1024M"+            `isPrefixOf` benchName = "-M1500M"         | "Data.Stream.ConcurrentEager/o-1-space."             `isPrefixOf` benchName = "-M128M" @@ -128,6 +114,17 @@         -- this, so the reason may be related to chunked streams.         | "Data.ParserK/o-1-space"             `isPrefixOf` benchName = "-K4M -M256M"+        | "Data.ParserK.Chunked/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"+        | "Data.ParserK.Chunked.Generic/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"++{-+        -- XXX This options does not seem to take effect. "ParserK.Chunked"+        -- needs more memory to work with --long option+        | "Data.ParserK.Chunked.Generic/o-1-space"+            `isPrefixOf` benchName = "-K4M -M256M"+-}          -----------------------------------------------------------------------
benchmark/lib/Streamly/Benchmark/Prelude.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Benchmark.Prelude@@ -62,7 +61,7 @@     , transformComposeMapM     , transformMapM     , transformTeeMapM-    , transformZipMapM+    -- , transformZipMapM     ) where @@ -78,7 +77,7 @@ import qualified Data.List as List import qualified Streamly.Prelude  as S import qualified Streamly.Internal.Data.Stream.IsStream as Internal-import qualified Streamly.Internal.Data.Stream.IsStream.Type as IsStream+import qualified Streamly.Internal.Data.Stream.IsStream as IsStream import qualified Streamly.Internal.Data.Pipe as Pipe import qualified Streamly.Internal.Data.Stream.Serial as Serial @@ -318,9 +317,10 @@     composeN n $     t .     Internal.transform-        (Pipe.mapM (\x -> return (x + 1)) `Pipe.tee`+        (Pipe.mapM (\x -> return (x + 1)) `Pipe.teeMerge`          Pipe.mapM (\x -> return (x + 2))) +{- {-# INLINE transformZipMapM #-} transformZipMapM ::        (S.IsStream t, S.MonadAsync m)@@ -336,6 +336,7 @@              (+)              (Pipe.mapM (\x -> return (x + 1)))              (Pipe.mapM (\x -> return (x + 2))))+-}  ------------------------------------------------------------------------------- -- Streams of streams
benchmark/streamly-benchmarks.cabal view
@@ -69,10 +69,23 @@ -------------------------------------------------------------------------------  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.+    if impl(ghc >= 9.10)+      default-language: GHC2024++    if impl(ghc >= 9.2) && impl(ghc < 9.10)+      default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions: StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -84,29 +97,20 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         TupleSections         TypeApplications-        TypeFamilies         TypeOperators-        ViewPatterns -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,-        -- otherwise TypeFamilies will enable it again.-        NoMonoLocalBinds--        -- UndecidableInstances -- Does not show any perf impact-        -- UnboxedTuples        -- interferes with (#.)+        -- Not in GHC2024+        CPP+        MagicHash+        RecordWildCards  common compile-options     import: default-extensions-    default-language: Haskell2010      if flag(use-streamly-core)       cpp-options:    -DUSE_STREAMLY_CORE@@ -175,7 +179,7 @@     -- Core libraries shipped with ghc, the min and max     -- constraints of these libraries should match with     -- the GHC versions we support-      base                >= 4.9   && < 4.20+      base                >= 4.9   && < 4.22     , deepseq             >= 1.4.1 && < 1.6     , mtl                 >= 2.2   && < 2.3.2 @@ -184,24 +188,26 @@     , random              >= 1.0   && < 2.0     , transformers        >= 0.4   && < 0.7     , containers          >= 0.5   && < 0.8-    , hashable            >= 1.3   && < 1.5+    , hashable            >= 1.3   && < 1.6     , unordered-containers >= 0.2 && < 0.3     , process             >= 1.4 && < 1.7     , directory         >= 1.2.2 && < 1.4     , filepath          >= 1.4.1 && < 1.6-    , ghc-prim          >= 0.4   && < 0.12-    , tasty-bench       >= 0.3 && < 0.4+    , ghc-prim          >= 0.4   && < 0.14+    , tasty-bench       >= 0.3 && < 0.5     , tasty             >= 1.4.1 && < 1.6     , streamly-core    if !flag(use-streamly-core)-    build-depends: streamly+    build-depends:+          streamly+        , bench-test-lib    if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)     build-depends:         fusion-plugin     >= 0.2   && < 0.3   if flag(inspection)-    build-depends:     template-haskell   >= 2.14  && < 2.22+    build-depends:     template-haskell   >= 2.14  && < 2.24                      , inspection-testing >= 0.4   && < 0.6   -- Array uses a Storable constraint in dev build making several inspection   -- tests fail@@ -228,7 +234,7 @@ common bench-options   import: compile-options, optimization-options, bench-depends   include-dirs: .-  ghc-options: -rtsopts+  ghc-options: -rtsopts -with-rtsopts "-t"   if flag(limit-build-mem)     ghc-options: +RTS -M512M -RTS   build-depends: streamly-benchmarks == 0.0.0@@ -238,42 +244,205 @@   import: compile-options, optimization-options, bench-depends   -- -threaded and -N2 is important because some GC and space leak issues   -- trigger only with these options.-  ghc-options: -threaded -rtsopts -with-rtsopts "-N2"+  ghc-options: -threaded -rtsopts -with-rtsopts "-t -N2"   if flag(limit-build-mem)     ghc-options: +RTS -M512M -RTS   build-depends: streamly-benchmarks == 0.0.0  ---------------------------------------------------------------------------------- Serial Streams+-- Listed in alphabetical order ------------------------------------------------------------------------------- -benchmark Data.Stream+benchmark Data.Array   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data-  main-is: Stream.hs+  hs-source-dirs: ., Streamly/Benchmark/Data+  main-is: Streamly/Benchmark/Data/Array.hs   other-modules:-      Stream.Generate-      Stream.Eliminate-      Stream.Transform-      Stream.Reduce-      Stream.Expand-      Stream.Lift       Stream.Common-  if !flag(use-streamly-core)-    other-modules:-      Stream.Exceptions+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True   if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++benchmark Data.Array.Generic+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: ., Streamly/Benchmark/Data+  main-is: Streamly/Benchmark/Data/Array/Generic.hs+  other-modules:+      Stream.Common+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS++benchmark Data.Array.Stream+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Array+  main-is: Stream.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11++benchmark Data.Fold+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Fold.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark Data.Fold.Prelude+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Fold+  -- XXX Using the name Prelude.hs causes compilation error+  main-is: Prelood.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++benchmark Data.Fold.Window+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Fold+  main-is: Window.hs+  -- MonoLocalBinds increases the memory requirement from 400MB to 1000MB,+  -- observed on macOS.+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS++benchmark Data.MutArray+  import: bench-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Benchmark/Data/MutArray.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS+  if flag(use-streamly-core)+    buildable: False+  else+    buildable: True++benchmark Data.Parser+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Parser.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11+  if flag(limit-build-mem)     if flag(dev)-      ghc-options: +RTS -M3500M -RTS+      ghc-options: +RTS -M3000M -RTS     else       ghc-options: +RTS -M2500M -RTS --- Use StreamK functions where possible, converting to StreaK to StreamD-benchmark Data.Stream.StreamDK+benchmark Data.ParserK   import: bench-options   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_SINGULAR+  main-is: ParserK.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11++benchmark Data.ParserK.Chunked+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_CHUNKED+  main-is: ParserK.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11++benchmark Data.ParserK.Chunked.Generic+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  cpp-options: -DBENCH_CHUNKED_GENERIC+  main-is: ParserK.hs+  if impl(ghcjs)+    buildable: False+  else+    buildable: True+    build-depends: exceptions >= 0.8   && < 0.11++benchmark Data.RingArray+  import: bench-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Benchmark/Data/RingArray.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++benchmark Data.Scanl+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data+  main-is: Scanl.hs++benchmark Data.Scanl.Window+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Window.hs++benchmark Data.Scanl.Concurrent+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Scanl+  main-is: Concurrent.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True++-- XXX Should be renamed to MutByteArray+benchmark Data.Serialize+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  cpp-options: -DUSE_TH+  main-is: Streamly/Benchmark/Data/Serialize.hs+  build-depends: QuickCheck, template-haskell+  other-modules:+      Streamly.Benchmark.Data.Serialize.TH+      Streamly.Benchmark.Data.Serialize.RecCompatible+      Streamly.Benchmark.Data.Serialize.RecNonCompatible+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS++benchmark Data.SmallArray+  import: bench-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Benchmark/Data/Array/SmallArray.hs+  if flag(dev) && !flag(use-streamly-core)+    buildable: True+  else+    buildable: False++benchmark Data.Stream+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data   main-is: Stream.hs   other-modules:       Stream.Generate@@ -282,20 +451,27 @@       Stream.Reduce       Stream.Expand       Stream.Lift+      Stream.Split       Stream.Common   if !flag(use-streamly-core)     other-modules:       Stream.Exceptions-  -- Cannot use USE_STREAMK and USE_PRELUDE together-  if flag(use-prelude)-    buildable: False-  cpp-options: -DUSE_STREAMK   if flag(limit-build-mem)     if flag(dev)       ghc-options: +RTS -M3500M -RTS     else       ghc-options: +RTS -M2500M -RTS +benchmark Data.Stream.Adaptive+  import: bench-options-threaded+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Data/Stream+  main-is: Adaptive.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True+ benchmark Data.Stream.Concurrent   import: bench-options-threaded   type: exitcode-stdio-1.0@@ -309,11 +485,11 @@   else     buildable: True -benchmark Data.Stream.ConcurrentInterleaved+benchmark Data.Stream.ConcurrentEager   import: bench-options-threaded   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/-  main-is: ConcurrentInterleaved.hs+  main-is: ConcurrentEager.hs   other-modules:       Stream.ConcurrentCommon       Stream.Common@@ -322,11 +498,11 @@   else     buildable: True -benchmark Data.Stream.ConcurrentEager+benchmark Data.Stream.ConcurrentInterleaved   import: bench-options-threaded   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/-  main-is: ConcurrentEager.hs+  main-is: ConcurrentInterleaved.hs   other-modules:       Stream.ConcurrentCommon       Stream.Common@@ -348,162 +524,153 @@   else     buildable: True -benchmark Data.Unbox-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: .-  cpp-options: -DUSE_UNBOX-  main-is: Streamly/Benchmark/Data/Serialize.hs--benchmark Data.Unbox.Derive.TH-  import: bench-options+benchmark Data.Stream.ConcurrentThreadHeavy+  import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: .-  cpp-options: -DUSE_UNBOX-  cpp-options: -DUSE_TH-  main-is: Streamly/Benchmark/Data/Serialize.hs+  hs-source-dirs: Streamly/Benchmark/Data/Stream+  main-is: ConcurrentThreadHeavy.hs+  if flag(use-streamly-core) || impl(ghcjs)+    buildable: False+  else+    buildable: True -benchmark Data.Serialize-  import: bench-options+benchmark Data.Stream.Rate+  import: bench-options-threaded   type: exitcode-stdio-1.0-  hs-source-dirs: .-  cpp-options: -DUSE_TH-  main-is: Streamly/Benchmark/Data/Serialize.hs-  build-depends: QuickCheck, template-haskell+  hs-source-dirs: Streamly/Benchmark/Data/Stream/, Streamly/Benchmark/Data/+  main-is: Rate.hs   other-modules:-      Streamly.Benchmark.Data.Serialize.TH-      Streamly.Benchmark.Data.Serialize.RecCompatible-      Streamly.Benchmark.Data.Serialize.RecNonCompatible-  if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS--benchmark Data.Unfold-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: .-  main-is: Streamly/Benchmark/Data/Unfold.hs+      Stream.ConcurrentCommon+      Stream.Common   if flag(use-streamly-core) || impl(ghcjs)     buildable: False   else     buildable: True -benchmark Data.Fold+benchmark Data.StreamK   import: bench-options   type: exitcode-stdio-1.0   hs-source-dirs: Streamly/Benchmark/Data-  main-is: Fold.hs-  if flag(use-streamly-core) || impl(ghcjs)+  main-is: StreamK.hs+  if impl(ghcjs)     buildable: False-  else-    buildable: True -benchmark Data.Fold.Window+-- XXX This needs to be cleaned up+benchmark Data.StreamK.FromStream   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Fold-  main-is: Window.hs-  if flag(use-streamly-core)+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: FromStream.hs+  if !flag(dev) || impl(ghcjs)     buildable: False-  else-    buildable: True -benchmark Data.Parser+benchmark Data.StreamK.StreamKAlt   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data-  main-is: Parser.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Data/StreamK+  main-is: StreamKAlt.hs+  if !flag(dev) || impl(ghcjs)     buildable: False-  else-    buildable: True-    build-depends: exceptions >= 0.8   && < 0.11-  if flag(limit-build-mem)-    if flag(dev)-      ghc-options: +RTS -M3000M -RTS-    else-      ghc-options: +RTS -M2000M -RTS -benchmark Data.ParserK+benchmark Data.Unbox   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data-  cpp-options: -DBENCH_SINGULAR-  main-is: ParserK.hs+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  main-is: Streamly/Benchmark/Data/Serialize.hs++benchmark Data.Unbox.Derive.TH+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  cpp-options: -DUSE_UNBOX+  cpp-options: -DUSE_TH+  main-is: Streamly/Benchmark/Data/Serialize.hs++benchmark Data.Unfold+  import: bench-options+  type: exitcode-stdio-1.0+  hs-source-dirs: .+  main-is: Streamly/Benchmark/Data/Unfold.hs   if impl(ghcjs)     buildable: False   else     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Data.ParserK.Chunked+benchmark FileSystem.Handle   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data-  cpp-options: -DBENCH_CHUNKED-  main-is: ParserK.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/FileSystem+  main-is: Handle.hs+  other-modules:+      Handle.Read+    , Handle.ReadWrite+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS+  if flag(use-streamly-core)     buildable: False   else     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11 -benchmark Data.ParserK.Chunked.Generic+benchmark FileSystem.DirIO   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data-  cpp-options: -DBENCH_CHUNKED_GENERIC-  main-is: ParserK.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/FileSystem+  main-is: DirIO.hs+  if flag(use-streamly-core)     buildable: False   else     buildable: True-    build-depends: exceptions >= 0.8   && < 0.11------------------------------------------------------------------------------------ Raw Streams--------------------------------------------------------------------------------+  -- Fix this benchmark for Windows+  if os(windows)+    buildable: False -benchmark Data.StreamD+benchmark Unicode.Char   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamD.hs-  if impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Char.hs+  -- Takes too much memory for ghcjs+  if flag(use-streamly-core) || impl(ghcjs)     buildable: False -benchmark Data.StreamK+benchmark Unicode.Parser   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamK.hs-  if impl(ghcjs)-    buildable: False+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Parser.hs -benchmark Data.Stream.ToStreamK+executable nano-bench   import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: ToStreamK.hs-  if !flag(dev) || impl(ghcjs)+  hs-source-dirs: .+  main-is: NanoBenchmarks.hs+  if !flag(dev)     buildable: False -benchmark Data.StreamK.Alt+benchmark Unicode.Stream   import: bench-options   type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Stream-  main-is: StreamKAlt.hs-  if !flag(dev) || impl(ghcjs)+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Stream.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1000M -RTS+  if flag(use-streamly-core)     buildable: False+  else+    buildable: True -executable nano-bench+benchmark Unicode.Utf8   import: bench-options-  hs-source-dirs: .-  main-is: NanoBenchmarks.hs-  if !flag(dev)+  type: exitcode-stdio-1.0+  hs-source-dirs: Streamly/Benchmark/Unicode+  main-is: Utf8.hs+  if flag(use-streamly-core)     buildable: False+  else+    buildable: True  ---------------------------------------------------------------------------------- Streamly.Prelude+-- Deprecated -------------------------------------------------------------------------------  benchmark Prelude@@ -519,7 +686,6 @@       Stream.Expand       Stream.Lift       Stream.Common-      Stream.Split       Stream.Exceptions   cpp-options: -DUSE_PRELUDE   if !flag(use-prelude)@@ -608,10 +774,6 @@   if flag(limit-build-mem)     ghc-options: +RTS -M2000M -RTS ----------------------------------------------------------------------------------- Concurrent Streams--------------------------------------------------------------------------------- benchmark Prelude.Concurrent   import: bench-options-threaded   type: exitcode-stdio-1.0@@ -638,141 +800,3 @@   cpp-options: -DUSE_PRELUDE   if !flag(use-prelude)     buildable: False------------------------------------------------------------------------------------ Array Benchmarks----------------------------------------------------------------------------------benchmark Data.Array.Generic-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: ., Streamly/Benchmark/Data-  main-is: Streamly/Benchmark/Data/Array/Generic.hs-  other-modules:-      Stream.Common-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True-  if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS--benchmark Data.SmallArray-  import: bench-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Array/SmallArray.hs-  if flag(dev) && !flag(use-streamly-core)-    buildable: True-  else-    buildable: False--benchmark Data.Array-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: ., Streamly/Benchmark/Data-  main-is: Streamly/Benchmark/Data/Array.hs-  other-modules:-      Stream.Common-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True-  if flag(limit-build-mem)-    ghc-options: +RTS -M1500M -RTS--benchmark Data.MutArray-  import: bench-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/MutArray.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M1500M -RTS-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True------------------------------------------------------------------------------------ Ring Benchmarks----------------------------------------------------------------------------------benchmark Data.Ring.Unboxed-  import: bench-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Benchmark/Data/Ring/Unboxed.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M1500M -RTS------------------------------------------------------------------------------------ Array Stream Benchmarks----------------------------------------------------------------------------------benchmark Data.Array.Stream-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Data/Array-  main-is: Stream.hs-  if flag(use-streamly-core) || impl(ghcjs)-    buildable: False-  else-    buildable: True-    build-depends: exceptions >= 0.8   && < 0.11------------------------------------------------------------------------------------ FileIO Benchmarks----------------------------------------------------------------------------------benchmark FileSystem.Handle-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/FileSystem-  main-is: Handle.hs-  other-modules:-      Handle.Read-    , Handle.ReadWrite-  if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True------------------------------------------------------------------------------------ Unicode Benchmarks----------------------------------------------------------------------------------benchmark Unicode.Stream-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Unicode-  main-is: Stream.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M1000M -RTS-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True--benchmark Unicode.Char-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Unicode-  main-is: Char.hs-  -- Takes too much memory for ghcjs-  if flag(use-streamly-core) || impl(ghcjs)-    buildable: False--benchmark Unicode.Utf8-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Unicode-  main-is: Utf8.hs-  if flag(use-streamly-core)-    buildable: False-  else-    buildable: True--benchmark Unicode.Parser-  import: bench-options-  type: exitcode-stdio-1.0-  hs-source-dirs: Streamly/Benchmark/Unicode-  main-is: Parser.hs
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly 0.10.1.+# Generated by GNU Autoconf 2.71 for streamly 0.11.0. # # Report bugs to <streamly@composewell.com>. #@@ -610,8 +610,8 @@ # Identity of this package. PACKAGE_NAME='streamly' PACKAGE_TARNAME='streamly'-PACKAGE_VERSION='0.10.1'-PACKAGE_STRING='streamly 0.10.1'+PACKAGE_VERSION='0.11.0'+PACKAGE_STRING='streamly 0.11.0' PACKAGE_BUGREPORT='streamly@composewell.com' PACKAGE_URL='https://streamly.composewell.com' @@ -1224,7 +1224,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures streamly 0.10.1 to adapt to many kinds of systems.+\`configure' configures streamly 0.11.0 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1286,7 +1286,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of streamly 0.10.1:";;+     short | recursive ) echo "Configuration of streamly 0.11.0:";;    esac   cat <<\_ACEOF @@ -1372,7 +1372,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-streamly configure 0.10.1+streamly configure 0.11.0 generated by GNU Autoconf 2.71  Copyright (C) 2021 Free Software Foundation, Inc.@@ -1500,7 +1500,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly $as_me 0.10.1, which was+It was created by streamly $as_me 0.11.0, which was generated by GNU Autoconf 2.71.  Invocation command line was    $ $0$ac_configure_args_raw@@ -3800,7 +3800,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by streamly $as_me 0.10.1, which was+This file was extended by streamly $as_me 0.11.0, which was generated by GNU Autoconf 2.71.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -3856,7 +3856,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly config.status 0.10.1+streamly config.status 0.11.0 configured by $0, generated by GNU Autoconf 2.71,   with options \\"\$ac_cs_config\\"
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly], [0.10.1], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])+AC_INIT([streamly], [0.11.0], [streamly@composewell.com], [streamly], [https://streamly.composewell.com])  # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])
docs/Developer/MAINTAINING.md view
@@ -175,7 +175,7 @@       package.yaml to the next major release target.     * Bump the package version in configure.ac to the next major release target       and run autoreconf.-    * Sync the package version of `streamly` and `streamly-docs`.+    * Sync the package version of `streamly`.     * Add an `Unreleased` section at the top of changelog file with the next       major release target.
docs/Developer/container-api.md view
@@ -16,9 +16,14 @@  ## Unfolds and Folds -* Unfolds are named as "read" or with a "read" prefix (e.g. readChunks).+* Unfolds are named as "reader" or with a "reader" suffix (e.g. chunkReader).+* Refolds are named as "writer" or with a "writer" suffix.+* Streams are names as "read" or with a "read" prefix. * Folds are named as "write" or with a "write" prefix (e.g. writeChunks). +Streams and fold API names are in line with the file system calls for reading+writing.+ ## To and from Stream  ### From and Put@@ -59,6 +64,9 @@ ## Random Access (Arrays)  ### Single elements++Especially for mutable arrays, the names "get" and "put" make better+sense as effectful APIs.  * getIndex (for arrays) * putIndex (for mutable arrays)
− docs/Developer/linked-lists.md 
@@ -1,32 +0,0 @@-# Linked Lists--The immutable Haskell lists or streams are great for stream processing.-However, they may not be suitable for purposes where we need to store data for-a longer while. In such cases we need mutable linked lists in pinned memory for-high performance applications i.e. we need the C like linked lists. Here are-some cases where linked-lists may be warranted instead of immutable lists:--* Let's say we want to buffer incoming data in a list. The buffered data may be-  millions of elements. When we are buffering we may allocate cells from-  different areas of the GC heap. When there are other activities going on we-  may have to keep copying this buffered data during GCs. When we consume this-  buffer, again it creates a fragmented heap and we may have to copy some other-  long-lived data to defragment the heap. The point is that we should not have-  long-lived data in the GC heap.--* When we delete a node in the list, Haskell lists have to be recreated-  generating a lot of garbage. We cannot take a reference to the unmodified-  segments and reuse them in the new list. On the other hand with mutable-  linked-lists we can delete a node cheaply. This could be a common case in a-  hash table collision chain which requires deletion of elements.--* Similar to deletion, if we need to insert an element in the middle of the-  list, an immutable list has to be re-created.--* To implement a queue, two lists in the immutable model can be used-  efficiently if we are strictly adding at the end and deleting from the front-  and if there is sufficient batching so that swapping of the lists is not a-  common operation. If we have to insert elements in the middle or if we have-  to swap too many times again we will have the same GC issues as stated above.-  For example, in implementations of priority search queues or timer wheels we-  have to mutate the lists.
docs/Developer/module-organization.md view
@@ -4,11 +4,17 @@  We keep all modules exposed to facilitate convenient exposure of experimental APIs and constructors to users. It allows users of the library to experiment-much more easily and carry a caveat that these APIs can change in future+much more easily but carry a caveat that these APIs can change in future without notice.  Since everything is exposed, maintainers do not have to think about what to expose as experimental and what remains completely hidden every time something is added to the library. +However, some modules are created purely for the purpose of breaking a module+into multiple smaller modules, or for organizing similar functionality in a+separate file, such modules are exported as entire module from a higher level+modules. These modules can remain hidden as they are fully exported via another+module.+ ## Internal module Namespace  We expose the internal modules via `Streamly.Internal.*` namespace to keep all@@ -21,7 +27,7 @@  * Keep the implementation of all the APIs in an internal module and just reexport selected APIs through the external module. The disadvantages of this-are:+approach are:    1) users may not be able to easily figure out what unexposed APIs are available   other than the ones exposed through the external module. To avoid this problem@@ -29,12 +35,13 @@    2) In tests and benchmarks we will be using internal modules to test internal   and unexposed APIs. Since exposed APIs are exported via both internal and-  external modules we will have to be careful in not using the internal module-  for testing accidentally, instead we should always be using the exposed module-  so that we are always testing exactly the way users will be using the APIs.+  external modules we will have to be careful in not accidentally using+  the internal module for testing, instead we should always be using the+  exposed module so that we are always testing exactly the way users+  will be using the APIs. -* Keep the implementations of unexposed modules in the internal module file-and exposed module in the external module file. In this approach, users can+* Keep the implementations of unexposed APIs in the internal module file+and exposed APIs in the external module file. In this approach, users can easily figure out the unexposed vs exposed APIs. But maintaining this would require us to move the APIs from internal to external module file whenever we expose an API.@@ -71,25 +78,26 @@  ## Constrained Modules -Some modules represent operations on a type which constrain a type using a type+Some modules represent operations on a type which constrain the type using a type class or a specific instance of a general type. For example, we may have Arrays-that operate on a `Storable` or a `Prim` type.+that operate on an `Unbox` type. -One possible way to organize such module is to have a `Storable` or `Prim`+One possible way to organize such modules is to have an `Unbox` hierarchy and all data structures using that type constraint are bundled under it. However, in general, a data structure may have multiple such constraints or may have to be organized based on some other dimension like an abstract interface it is implementing. -General purpose constraints like `Prim` can be defined in their own module+General purpose constraints like `Unbox` can be defined in their own module hierarchy and can be used everywhere. For example, we can have the following-Array types, here we have organized the types under the `Array` hierarchy-rather than putting the `PrimArray` under a `Prim` hierarchy.+Array types, here we have organized all array types under the `Array` hierarchy+rather than having e.g. `Unbox.Array` for unboxed arrays.  ```-Streamly.Internal.Data.Array.Boxed-Streamly.Internal.Data.Array.Prim-Streamly.Internal.Data.Array.Prim.Pinned+Streamly.Internal.Data.Array -- Unboxed arrays+Streamly.Internal.Data.Array.Generic -- Boxed arrays+Streamly.Internal.Data.MutArray -- Unboxed mutable arrays+Streamly.Internal.Data.MutArray.Generic -- Boxed mutable arrays ```  ## Common Modules@@ -171,71 +179,36 @@  ## Stream modules -By default the streaming modules are effectful. The basic effectful-stream types are:+Effectful streams are fused or CPS types:  * `Streamly.Data.Stream`-* `Streamly.Data.Stream.Async`-* `Streamly.Data.Stream.Ahead`-* `Streamly.Data.Stream.Parallel`-* `Streamly.Data.Stream.IsStream` -- polymorphic operations-* `Streamly.Data.Stream.Using`    -- e.g. mapMUsing consMAsync--The above streams have an append-like multi-stream combining behavior-i.e. `concatMap` and `bind` would by default evaluate the streams one-after another. Alternative implementations of `concatMap` and `bind` are-possible. We can either use rebindable syntax to use a different bind or-define newtypes with a different bind behavior, all other operations for-these remain the same as the base type:--* `Streamly.Data.Stream.Zip`-* `Streamly.Data.Stream.Interleaved`-* `Streamly.Data.Stream.RoundRobin`-* `Streamly.Data.Stream.Async.Zip`-* `Streamly.Data.Stream.Async.Interleaved`-* `Streamly.Data.Stream.Async.RoundRobin`-* ...+* `Streamly.Data.StreamK`+* `Streamly.Data.Stream.Prelude`  Pure streams are a special case of effectful streams and have the same interface as lists, so we put them under `Streamly.Data.List`:  * `Streamly.Data.List`-* `Streamly.Data.List.Zip`-* `Streamly.Data.List.Interleaved`-* `Streamly.Data.List.RoundRobin`-* ...--We could possibly use the same type named `Stream` for all stream-types, as the names of all stream operation are also the same and we-distinguish only by the module name.+* `Streamly.Data.ListK`  ## Array modules  Similarly, the immutable Array modules would go in: -* `Streamly.Data.Array.Generic`                  -- unpinned, native memory arrays-* `Streamly.Data.Array.Storable`         -- unpinned, unboxed, native memory arrays-* `Streamly.Data.Array.Storable.Pinned`  -- pinned, unboxed, native memory arrays-* `Streamly.Data.Array.Foreign` -- pinned, unboxed, foreign capable arrays--Unboxed arrays, based on `Prim` type class:--* `Streamly.Data.Array.Prim`-* `Streamly.Data.Array.Prim.Pinned`+* Streamly.Data.Array -- Unboxed arrays+* Streamly.Data.Array.Generic -- Boxed arrays  Mutable arrays are a generalization of immutable arrays: -* `Streamly.Data.MutArray`-* `Streamly.Data.Array.Storable.Mut`-* `Streamly.Data.Array.Storable.Pinned.Mut`-* ...+* Streamly.Data.MutArray -- Unboxed mutable arrays+* Streamly.Data.MutArray.Generic -- Boxed mutable arrays  ## Stream and Fold Channels (SVar)  * `Streamly.Data.Stream.Channel`-* `Streamly.Data.Stream.Channel.Storable`+* `Streamly.Data.Stream.Channel.Unboxed` * `Streamly.Data.Fold.Channel`-* `Streamly.Data.Fold.Channel.Storable`+* `Streamly.Data.Fold.Channel.Unboxed`  ## Mutable variables
docs/Developer/optimization-guidelines.md view
@@ -25,7 +25,7 @@ before you optimize:  * See if you actually need more performance-* See if the code you are optimizing is in fast path+* See if the code you are optimizing is in fast path of your application  ### Stream Fusion @@ -54,7 +54,7 @@ * Use unfolds especially when higher order operations are involved. For   example, `unfoldMany` can fuse completely whereas `concatMap` would   not fuse.-* Use `outerProduct` in `Unfold` module instead of using the monad instance of+* Use `outerProduct` from the `Unfold` module instead of using the monad instance of   streams to fuse nested loops where performance matters. See the unfold   benchmarks for an example. `outerProduct` can give you C like nested loop   performance.@@ -85,7 +85,7 @@  ### Streams and Unfolds -Stream and Unfold State.  Direct style stream and unfold combinators use a+Stream and Unfold State: Direct style stream and unfold combinators use a state data type to represent the internal state of the stream/unfold generator.  * In some cases we may have to add a `FUSE` annotation on the state type to@@ -191,6 +191,18 @@ itself, in fact we may have to occasionally use a `NOINLINE` so that the compiler does not inline it. +We need to be careful about NOINLINE on polymorphic functions. When+NOINLINE is used, the function cannot be specialized causing huge+performance degradation.  To avoid that we can either make the+function monomorphic or sometimes using `NOINLINE [0]` can do the+trick. `NOINLINE [0]` blocks inlining in earlier phases but lets it+specialize in the last phase, inlining in the last phase is left to+the compiler. `INLINE [0]` may sound the same as `NOINLINE [0]`,+however, it behaves differently because we ask the compiler to INLINE+it compulsorily and it may not give us the desired results. The+Data.Fold.createOfLast benchmark is one such case where `NOINLINE [0]`+provides much better performance than `INLINE [0]`.+ ### NoSpecConstr  It is not always useful to specialize function calls for all constructors, some@@ -200,19 +212,34 @@  ### StreamK operations -StreamK uses foldr/build fusion to a very limited degree. StreamK is not the-primary representation in streamly but is used for several operations that-cannot scale in StreamD representation. StreamK is relatively immune to compiler-optimizations. In some cases you may need an INLINE pragma to improve the-performance.+StreamK (CPS based stream type) uses foldr/build fusion to a very+limited degree. StreamK is not the primary representation in streamly+but is used for several operations that cannot scale in fused `Stream`+type representation. StreamK is relatively immune to compiler+optimizations. In some cases you may need an INLINE pragma on the+StreamK operation to improve its performance. +## Debugging Fusion Issues++### How to find non-fusing code?++The fusion-plugin reports operations that do not fuse. It has many verbosity+options to give even more information about the constructors that are not+fusing. Read the readme of the fusion-plugin package for more details.++When the code is not fusing you will see a lot more (e.g. 10x) allocations+compared to the case when it is fusing.++<!-- It is important to note where to expect fusion and where fusion is not+possible. -->+ ### How to debug non-fusing code?  Strip down the code to a minimal version until it starts fusing and then start building it up from there adding more things incrementally. At each stage keep checking if the code is fusing. At some point it won't fuse. See what we added that made the code not fuse. Go through-the guidelines above to check if we did something that that is not+the guidelines above to check if we did something that is not recommended. Or raise an issue for GHC to be fixed if possible.  # GHC Optimizations In Streamly@@ -317,18 +344,22 @@ as `INLINE` or `INLINE_EARLY`, instead they should all be marked as `INLINE_NORMAL` because higher order functions like `concatMap`/`map`/`mapM` etc are marked as `INLINE_NORMAL`. `StreamD` functions in other modules like-`Streamly.Data.Array.Foreign` should also follow the same rules.+`Streamly.Data.Array` should also follow the same rules. +Use INLINE_NORMAL on functions like `pipe`, `Pipe.compose`, `Pipe.teeMerge` for+complete fusion in a pipeline of multiple such operations e.g. in the `pipesX4`+benchmarks.+ ## Stream Fusion -In StreamD combinators, inlining the inner step or loop functions too early+In fused `Stream` type combinators, inlining the inner step or loop functions too early i.e. in the same phase or before the outer function is inlined may block stream fusion opportunities. Therefore, the inner step functions and folding loops are marked as INLINE_LATE.  ## Specialization -In some cases, the `step` function in `StreamD` does not get specialized when+In some cases, the `step` function in `Stream` does not get specialized when inlined unless it is provided with an explicit signature or made a lambda, for example, in the `replicate/replicateM` combinator we need the type annotation on `i` to get it specialized:@@ -356,3 +387,51 @@ these code blocks which in turn can affect stream fusion.  See https://gitlab.haskell.org/ghc/ghc/issues/17075 .++## Avoiding polymorphism++Polymorphism can add unwanted inefficiencies, so avoid where possible. For+example, more efficient code:++```+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> IO b) -> m b+```++Less efficient version, because of a wroker-wrapper indirection (see+https://github.com/composewell/streamly/issues/2589):++```+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+```++Using explicit type annotation+------------------------------++Having polymorphic types may hinder specialization and hurt performance. See+the specialization section in design/inlining.md in streamly docs++In some cases, the `step` function in `Stream` does not get specialized when+inlined unless it is provided with an explicit signature or made a lambda, for+example, in the `replicate/replicateM` combinator we need the type annotation+on `i` to get it specialized:++```+    {-# INLINE_LATE step #-}+    step _ (i :: Int) =+        if i <= 0+        then return Stop+        else do+                x <- action+                return $ Yield x (i - 1)+```++In this case if the compiler does not infer the type of i automatically then we+will be forced to provide the type and get it specialized.++Strict State in Streams+-----------------------++Depending on the context, sometimes using strict data structures for+stream state can provide better performance. In case the state does not+fuse, making it strict will avoid performance problems due to state+being lazy.
docs/Developer/paths.rst view
@@ -251,3 +251,13 @@ * https://unix.stackexchange.com/questions/2089/what-charset-encoding-is-used-for-filenames-and-paths-on-linux * https://docs.microsoft.com/en-us/windows/win32/intl/character-sets-used-in-file-names * https://beets.io/blog/paths.html++Related Packages+----------------++* https://hackage.haskell.org/package/paths+* https://hackage.haskell.org/package/path+* https://hackage.haskell.org/package/hpath+* https://hackage.haskell.org/package/filepath+* https://hackage.haskell.org/package/file-io+* https://hackage.haskell.org/package/os-string
docs/Developer/resources.md view
@@ -30,6 +30,7 @@ * [Stackless purescript](http://blog.functorial.com/posts/2015-07-31-Stackless-PureScript.html) * [Coroutine Pipelines](https://themonadreader.files.wordpress.com/2011/10/issue19.pdf) * [Faster Coroutine Pipelines](https://dl.acm.org/ft_gateway.cfm?id=3110249&ftid=1902054&dwn=1&CFID=982135108&CFTOKEN=78426775)+* [Faster Coroutine Pipelines: A Reconstruction](https://rubenpieters.github.io/assets/papers/JFP20-pipes.pdf)  ## Distributed * [Making reliable distributed systems in the presence of software errors](http://erlang.org/download/armstrong_thesis_2003.pdf)
− docs/Setup.hs 
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
− docs/User/Explanatory/Overview.md 
@@ -1,468 +0,0 @@-# Streaming--These are some notes from an old version of README that may be-useful. For a quick introduction please read the README.md at the repo-root first.--## Streamly--Streamly is a general computing framework based on data flow programming also-known as streaming. Moreover streamly supports concurrent dataflow programming.--Streaming in general enables writing modular, composable and scalable-applications with ease, and concurrency allows you to make them scale and-perform well.  Streamly enables writing scalable concurrent applications-without being aware of threads or synchronization. No explicit thread-control is needed. Where applicable, concurrency rate is automatically-controlled based on the demand by the consumer. However, combinators can be-used to fine tune the concurrency control.--Streaming and concurrency together enable expressing reactive applications-conveniently. See the @CirclingSquare@ example in-<https://github.com/composewell/streamly-examples Streamly Examples> for-a simple SDL based FRP example. To summarize, streamly provides a unified-computing framework for streaming, non-determinism and functional reactive-programming in an elegant and simple API that is a natural extension of pure-lists to monadic streams.--## What are streams?--In simple terms, streams are the functional equivalent of loops in-imperative programming.--A stream is a representation of potentially infinite data sequence.  You-can compose a pipeline of functions or stream processors to process-an input stream of data to produce an output stream. We call it a-form of dataflow programming as data flows through the processing-logic. In imperative programming there is no clear separation of data-and logic. The logic can arbitrarily examine and mutate data which-creates a problem due to complex interleaving of state and logic in the-program.--In streamly there are two fundamental data structures, streams and arrays.-Streams are for dataflow style processing while arrays are for storing data.-Both taken together are powerful tools for general purpose programming in a-functional or dataflow style.--## Loops vs Streams--In imperative programming when we have to process a sequence of items-or an array of data we run a loop over it, each iteration of the loop-examines the data to do something with it and produce an output.--Loops are a low level, monolithic and general concept. Whereas streams-are high level, structured and modular way of expressing what you usualy-do with loops. Streams allow you to write different parts of the loop-as separate modular combinators and then compose them to create bigger-loops.--## Streaming Concurrently--Haskell lists express pure computations using composable stream operations like-`:`, `unfold`, `map`, `filter`, `zip` and `fold`.  Streamly is exactly like-lists except that it can express sequences of pure as well as monadic-computations aka streams. More importantly, it can express monadic sequences-with concurrent execution semantics without introducing any additional APIs.--Streamly expresses concurrency using standard, well known abstractions.-Concurrency semantics are defined for list operations, semigroup, applicative-and monadic compositions. Programmer does not need to know any low level-notions of concurrency like threads, locking or synchronization.  Concurrent-and non-concurrent programs are fundamentally the same.  A chosen segment of-the program can be made concurrent by annotating it with an appropriate-combinator.  We can choose a combinator for lookahead style or asynchronous-concurrency.  Concurrency is automatically scaled up or down based on the-demand from the consumer application, we can finally say goodbye to managing-thread pools and associated sizing issues.  The result is truly fearless-and declarative monadic concurrency.--## Where to use streamly?--Streamly is a general purpose programming framework.  It can be used equally-efficiently from a simple `Hello World!` program to a massively concurrent-application. The answer to the question, "where to use streamly?" - would be-similar to the answer to - "Where to use Haskell lists or the IO monad?".--Streamly simplifies streaming and makes it as intuitive as plain lists. Unlike-other streaming libraries, no fancy types are required.  Streamly is simply a-generalization of Haskell lists to monadic streaming optionally with concurrent-composition. The basic stream type in streamly `SerialT m a` can be considered-as a list type `[a]` parameterized by the monad `m`. For example, `SerialT IO-a` is a moral equivalent of `[a]` in the IO monad. `SerialT Identity a`, is-equivalent to pure lists.  Streams are constructed very much like lists, except-that they use `nil` and `cons` instead of `[]` and `:`.  Unlike lists, streams-can be constructed from monadic effects, not just pure elements.  Streams are-processed just like lists, with list like combinators, except that they are-monadic and work in a streaming fashion. In other words streamly just completes-what lists lack, you do not need to learn anything new. Please see [streamly vs-lists](/docs/User/HowTo/streamly-vs-lists.md) for a detailed comparison.--Not surprisingly, the monad instance of streamly is a list transformer, with-concurrency capability.--## Why data flow programming?--If you need some convincing for using streaming or data flow programming-paradigm itself then try to answer this question - why do we use lists in-Haskell? It boils down to why we use functional programming in the first place.-Haskell is successful in enforcing the functional data flow paradigm for pure-computations using lists, but not for monadic computations. In the absence of a-standard and easy to use data flow programming paradigm for monadic-computations, and the IO monad providing an escape hatch to an imperative-model, we just love to fall into the imperative trap, and start asking the same-fundamental question again - why do we have to use the streaming data model?--## Streaming Pipelines--The following snippet provides a simple stream composition example that reads-numbers from stdin, prints the squares of even numbers and exits if an even-number more than 9 is entered.--``` haskell-import qualified Streamly.Prelude as S-import Data.Function ((&))--main = S.drain $-       S.repeatM getLine-     & fmap read-     & S.filter even-     & S.takeWhile (<= 9)-     & fmap (\x -> x * x)-     & S.mapM print-```--Unlike `pipes` or `conduit` and like `vector` and `streaming`, `streamly`-composes stream data instead of stream processors (functions).  A stream is-just like a list and is explicitly passed around to functions that process the-stream.  Therefore, no special operator is needed to join stages in a streaming-pipeline, just the standard function application (`$`) or reverse function-application (`&`) operator is enough.--## Concurrent Stream Generation--`consM` or its operator form `|:` can be used to construct a stream from-monadic actions. A stream constructed with `consM` can run the monadic actions-in the stream concurrently when used with appropriate stream type combinator-(e.g. `fromAsync`, `fromAhead` or `fromParallel`).--The following code finishes in 3 seconds (6 seconds when serial), note the-order of elements in the resulting output, the outputs are consumed as soon as-each action is finished (asyncly):--``` haskell-> let p n = threadDelay (n * 1000000) >> return n-> S.toList $ S.fromAsync $ p 3 |: p 2 |: p 1 |: S.nil-[1,2,3]-```--Use `fromAhead` if you want speculative concurrency i.e. execute the actions in-the stream concurrently but consume the results in the specified order:--``` haskell-> S.toList $ S.fromAhead $ p 3 |: p 2 |: p 1 |: S.nil-[3,2,1]-```--Monadic stream generation functions e.g. `unfoldrM`, `replicateM`, `repeatM`,-`iterateM` and `fromFoldableM` etc. can work concurrently.--The following finishes in 10 seconds (100 seconds when serial):--``` haskell-S.drain $ S.fromAsync $ S.replicateM 10 $ p 10-```--## Concurrent Streaming Pipelines--Use `|&` or `|$` to apply stream processing functions concurrently. The-following example prints a "hello" every second; if you use `&` instead of-`|&` you will see that the delay doubles to 2 seconds instead because of serial-application.--``` haskell-main = S.drain $-      S.repeatM (threadDelay 1000000 >> return "hello")-   |& S.mapM (\x -> threadDelay 1000000 >> putStrLn x)-```--## Mapping Concurrently--We can use `mapM` or `sequence` functions concurrently on a stream.--``` haskell-> let p n = threadDelay (n * 1000000) >> return n-> S.drain $ S.fromAhead $ S.mapM (\x -> p 1 >> print x) (S.fromSerial $ S.repeatM (p 1))-```--## Serial and Concurrent Merging--Semigroup and Monoid instances can be used to fold streams serially or-concurrently. In the following example we compose ten actions in the-stream, each with a delay of 1 to 10 seconds, respectively. Since all the-actions are concurrent we see one output printed every second:--``` haskell-import qualified Streamly.Prelude as S-import Control.Concurrent (threadDelay)--main = S.toList $ S.fromParallel $ foldMap delay [1..10]- where delay n = S.fromEffect $ threadDelay (n * 1000000) >> print n-```--Streams can be combined together in many ways. We provide some examples-below, see the tutorial for more ways. We use the following `delay`-function in the examples to demonstrate the concurrency aspects:--``` haskell-import qualified Streamly.Prelude as S-import Control.Concurrent--delay n = S.fromEffect $ do-    threadDelay (n * 1000000)-    tid <- myThreadId-    putStrLn (show tid ++ ": Delay " ++ show n)-```-### Serial--``` haskell-main = S.drain $ delay 3 <> delay 2 <> delay 1-```-```-ThreadId 36: Delay 3-ThreadId 36: Delay 2-ThreadId 36: Delay 1-```--### Parallel--``` haskell-main = S.drain . S.fromParallel $ delay 3 <> delay 2 <> delay 1-```-```-ThreadId 42: Delay 1-ThreadId 41: Delay 2-ThreadId 40: Delay 3-```--## Nested Loops (aka List Transformer)--The monad instance composes like a list monad.--``` haskell-import qualified Streamly.Prelude as S--loops = do-    x <- S.fromFoldable [1,2]-    y <- S.fromFoldable [3,4]-    S.fromEffect $ putStrLn $ show (x, y)--main = S.drain loops-```-```-(1,3)-(1,4)-(2,3)-(2,4)-```--## Concurrent Nested Loops--To run the above code with speculative concurrency i.e. each iteration in the-loop can run concurrently but the results are presented to the consumer of the-output in the same order as serial execution:--``` haskell-main = S.drain $ S.fromAhead $ loops-```--Different stream types execute the loop iterations in different ways. For-example, `fromWSerial` interleaves the loop iterations. There are several-concurrent stream styles to execute the loop iterations concurrently in-different ways, see the `Streamly.Tutorial` module for a detailed treatment.--## Magical Concurrency--Streams can perform semigroup (<>) and monadic bind (>>=) operations-concurrently using combinators like `fromAsync`, `parallelly`. For example,-to concurrently generate squares of a stream of numbers and then concurrently-sum the square roots of all combinations of two streams:--``` haskell-import qualified Streamly.Prelude as S--main = do-    s <- S.sum $ S.fromAsync $ do-        -- Each square is performed concurrently, (<>) is concurrent-        x2 <- foldMap (\x -> return $ x * x) [1..100]-        y2 <- foldMap (\y -> return $ y * y) [1..100]-        -- Each addition is performed concurrently, monadic bind is concurrent-        return $ sqrt (x2 + y2)-    print s-```--## Rate Limiting--For bounded concurrent streams, stream yield rate can be specified. For-example, to print hello once every second you can simply write this:--``` haskell-import Streamly.Prelude as S--main = S.drain $ S.fromAsync $ S.avgRate 1 $ S.repeatM $ putStrLn "hello"-```--For some practical uses of rate control, see-[AcidRain.hs](https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs)-and-[CirclingSquare.hs](https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs)-.-Concurrency of the stream is automatically controlled to match the specified-rate. Rate control works precisely even at throughputs as high as millions of-yields per second. For more sophisticated rate control see the haddock-documentation.--## Arrays--The `Streamly.Data.Array.Foreign` module provides immutable arrays.  Arrays are the-computing duals of streams. Streams are good at sequential access and immutable-transformations of in-transit data whereas arrays are good at random access and-in-place transformations of buffered data. Unlike streams which are potentially-infinite, arrays are necessarily finite. Arrays can be used as an efficient-interface between streams and external storage systems like memory, files and-network. Streams and arrays complete each other to provide a general purpose-computing system. The design of streamly as a general purpose computing-framework is centered around these two fundamental aspects of computing and-storage.--`Streamly.Data.Array.Foreign` uses pinned memory outside GC and therefore avoid any-GC overhead for the storage in arrays. Streamly allows efficient-transformations over arrays using streams. It uses arrays to transfer data to-and from the operating system and to store data in memory.--## Folds--Folds are consumers of streams.  `Streamly.Data.Fold` module provides a `Fold`-type that represents a `foldl'`.  Such folds can be efficiently composed-allowing the compiler to perform stream fusion and therefore implement high-performance combinators for consuming streams. A stream can be distributed to-multiple folds, or it can be partitioned across multiple folds, or-demultiplexed over multiple folds, or unzipped to two folds. We can also use-folds to fold segments of stream generating a stream of the folded results.--If you are familiar with the `foldl` library, these are the same composable-left folds but simpler and better integrated with streamly, and with many more-powerful ways of composing and applying them.--## Unfolds--Unfolds are duals of folds. Folds help us compose consumers of streams-efficiently and unfolds help us compose producers of streams efficiently.-`Streamly.Data.Unfold` provides an `Unfold` type that represents an `unfoldr`-or a stream generator. Such generators can be combined together efficiently-allowing the compiler to perform stream fusion and implement high performance-stream merging combinators.--## File IO--The following code snippets implement some common Unix command line utilities-using streamly.  You can compile these with `ghc -O2 -fspec-constr-recursive=16--fmax-worker-args=16` and compare the performance with regular GNU coreutils-available on your system.  Though many of these are not most optimal solutions-to keep them short and elegant. Source file-[CoreUtilsHandle.hs](https://github.com/composewell/streamly-examples/blob/master/examples/CoreUtilsHandle.hs)-in the examples directory includes these examples.--``` haskell-module Main where--import qualified Streamly.Prelude as S-import qualified Streamly.Data.Fold as FL-import qualified Streamly.Data.Array.Foreign as A-import qualified Streamly.FileSystem.Handle as FH-import qualified System.IO as FH--import Data.Char (ord)-import System.Environment (getArgs)-import System.IO (openFile, IOMode(..), stdout)--withArg f = do-    (name : _) <- getArgs-    src <- openFile name ReadMode-    f src--withArg2 f = do-    (sname : dname : _) <- getArgs-    src <- openFile sname ReadMode-    dst <- openFile dname WriteMode-    f src dst-```--### cat--``` haskell-cat = S.fold (FH.writeChunks stdout) . S.unfold FH.readChunks-main = withArg cat-```--### cp--``` haskell-cp src dst = S.fold (FH.writeChunks dst) $ S.unfold FH.readChunks src-main = withArg2 cp-```--### wc -l--``` haskell-wcl = S.length . S.splitOn (== 10) FL.drain . S.unfold FH.read-main = withArg wcl >>= print-```--### Average Line Length--``` haskell-avgll =-      S.fold avg-    . S.splitOn (== 10) FL.length-    . S.unfold FH.read--    where avg      = (/) <$> toDouble FL.sum <*> toDouble FL.length-          toDouble = fmap (fromIntegral :: Int -> Double)--main = withArg avgll >>= print-```--### Line Length Histogram--`classify` is not released yet, and is available in-`Streamly.Internal.Data.Fold`--``` haskell-llhisto =-      S.fold (FL.classify FL.length)-    . S.map bucket-    . S.splitOn (== 10) FL.length-    . S.unfold FH.read--    where-    bucket n = let i = n `mod` 10 in if i > 9 then (9,n) else (i,n)--main = withArg llhisto >>= print-```--## Exceptions--Exceptions can be thrown at any point using the `MonadThrow` instance. Standard-exception handling combinators like `bracket`, `finally`, `handle`,-`onException` are provided in `Streamly.Prelude` module.--In presence of concurrency, synchronous exceptions work just the way they are-supposed to work in non-concurrent code. When concurrent streams-are combined together, exceptions from the constituent streams are propagated-to the consumer stream. When an exception occurs in any of the constituent-streams other concurrent streams are promptly terminated.--There is no notion of explicit threads in streamly, therefore, no-asynchronous exceptions to deal with. You can just ignore the zillions of-blogs, talks, caveats about async exceptions. Async exceptions just don't-exist.  Please don't use things like `myThreadId` and `throwTo` just for fun!
+ docs/User/Explanatory/performance-benchmarks.md view
@@ -0,0 +1,7 @@+# Performance++Streamly is highly optimized for performance, it is designed for+high performing, concurrent and scalable applications. Please see the+[streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)+package for microbencmarks measuring the performance of streamly and comparing+it with other streaming libraries.
− docs/User/Explanatory/performance.md 
@@ -1,7 +0,0 @@-# Performance--Streamly is highly optimized for performance, it is designed for-high performing, concurrent and scalable applications. Please see the-[streaming-benchmarks](https://github.com/composewell/streaming-benchmarks)-package for microbencmarks measuring the performance of streamly and comparing-it with other streaming libraries.
+ docs/User/Explanatory/streams.md view
@@ -0,0 +1,88 @@+# Stream Fusion++The fused 'Stream' type employs stream fusion for C-like performance when+looping over data. It represents the stream as a state machine using an+explicit state, and a step function working on the state. A typical stream+operation consumes elements from the previous state machine in a stream+pipeline, transforms the elements and yields new values for the next stage to+consume. One stream operation typically represents one stage of a modular+pipeline, representing a single task, stages in the pipeline have no knowledge+of the state of the previous or next stage.++A typical stream pipeline consists of a stream producer, several stream+transformation operations and a stream consumer. All these operations taken+together form a closed loop (like a for or while loop) processing the stream+elements. Elements are transferred between stages using a boxed data+constructor. However, all the stages of the pipeline are "fused" together by+GHC, eliminating the boxing of intermediate constructors, and thus forming a+tight C like loop without any boxed data being used in the loop.++Stream fusion works effectively when:++* the stream pipeline is composed statically (known at compile time)+* all the operations forming the loop are inlined+* the loop is not recursively defined, recursion breaks inlining++If these conditions cannot be met, the CPS style stream type 'StreamK' may+turn out to be a better choice than the fused stream type 'Stream'.++## Stream vs StreamK++The fused stream model avoids constructor allocations and function call+overheads. However, the stream is represented as a state machine, and to+generate stream elements it has to navigate the decision tree of the state+machine. Moreover, the state machine is cranked for each element in the stream.+This performs extremely well when the number of states are limited. The state+machine starts getting expensive as the number of states increase. For example,+generating a stream from a list requires a single state and is very efficient,+even if it has millions of elements, there is only one state machine. However,+using 'cons' to construct a million element stream would be a disaster because+it is statically fusing a million state machines.++A typical worst case scenario for fused stream model is a large number of+`cons` or `append` operations. A few static `cons` or `append` operations+are very fast, much faster than a CPS style stream because CPS involves a+function call for each element whereas fused stream involves a few+conditional branches in the state machine. However, constructing a large+stream using `cons` introduces as many states in the state machine as the+number of elements. If we compose `cons` as a balanced binary tree it will+take @n * log n@ time to navigate the tree, and @n * n@ if it is a right+associative composition.++Operations like 'cons' or 'append' are typically recursively called to+construct a lazy infinite stream. For such use cases the CPS style 'StreamK'+should be used. CPS streams do not use an explicit state machine that needs to be+cranked for each element, past state has no effect on the future element+processing. However, CPS incurs a function call overhead for each element+processed, the overhead could be large compared to a fused state machine+even if it has many states. However, because of its linear performance+characteristics, after a certain threshold of stream compositions the CPS+stream would perform much better than the quadratic fused stream operations.++As a general guideline, you need to use 'StreamK' when you have to use+'cons', 'append' or other operations having quadratic complexity at a large+scale. Typically, in such cases you need to compose the stream recursively,+by calling an operation in a loop. The decision to compose the stream is+taken at run time rather than statically at compile time.++Typically you would compose a 'StreamK' of chunks of data so that the StreamK+function call overhead is mitigated, and then process each chunk using 'Stream'+type operations by using statically fused stream pipeline operations on the+chunks.++'Stream' and 'StreamK' types can be interconverted. See+"Streamly.Data.StreamK" module for conversion operations.++## Fold Fusion++Folds support stream fusion for generating loops comparable to the speed of+C. However, it has some limitations. For fusion to work, the folds must be+inlined, folds must be statically known and not generated dynamically, folds+should not be passed recursively.++Another limitation is due to the quadratic complexity causing slowdown when+too many nested compositions are used. Especially, the performance of the+Applicative instance and splitting operations (e.g. 'splitWith') degrades+quadratically (O(n^2)) when combined @n@ times, roughly 8 or less sequenced+operations are fine. For these cases folds can be converted to parsers and+then used as ParserK.
docs/User/Explanatory/unified-abstractions.md view
@@ -8,7 +8,7 @@ This document discusses the related packages in the Haskell ecosystem and how streamly unifies, overlaps, or compares with those. We provide simple code snippets for illustrations, for a better overview of the-library please see the [Streamly Quick Overview](/docs/User/Tutorials/quick-overview.md) document.+library please see the [Streamly Quick Overview](/docs/User/Tutorials/learn-by-examples.md) document.  ## Existing Haskell Libraries @@ -79,11 +79,15 @@ This simple console echo program shows the simplicity of Streamly API and its similarity with the list API: -```haskell+```haskell unshared+import Data.Function ((&))+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold+ echo =       Stream.repeatM getLine     & Stream.mapM putStrLn-    & Stream.drain+    & Stream.fold Fold.drain ```  Streamly uses dual representation for streams. On top it uses Scott@@ -105,20 +109,35 @@ programming. List transformers are the basic implementations for non-determinism. -The stream monad in Streamly is a list-transformer with behavior similar-to the list monad. It provides the functionality provided by `list-t` or-`logict` packages for free.  Here is an example of nested looping using-the serial stream monad:+You can use `Streamly.Data.Stream.MkType` to create a custom type and specify+the behaviour of non-determinism. The basic `concatMap` would result in a+list-transformer with behavior similar to the list monad. It provides the+functionality provided by `list-t` or `logict` packages for free.  Here is an+example of nested looping using the new type:  ```haskell-import qualified Streamly.Prelude as S+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-} -loops = do-    x <- Stream.fromFoldable [1,2]-    y <- Stream.fromFoldable [3,4]-    Stream.fromEffect $ print (x, y)+import Streamly.Data.Stream.Prelude (Stream, MonadAsync)+import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.StreamK as StreamK+import Streamly.Data.Stream.MkType++bindSerial :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+bindSerial = flip Stream.concatMap+$(mkCrossType "CrossT" "bindSerial" False)++loopsCross :: Stream IO ()+loopsCross = unCrossT $ do+    x <- CrossT $ Stream.fromList [1,2]+    y <- CrossT $ Stream.fromList [3,4]+    CrossT $ Stream.fromEffect $ print (x, y) ``` +`Streamly.Data.Stream.CrossStream` and `Streamly.Data.StreamK.CrossStreamK`+provide the same functionality as `CrossT` type created above.+ Moreover, the list transformer in Streamly can be concurrent. The Scott encoding of streams also avoids the quadratic performance issue of `logict`.@@ -142,12 +161,18 @@  The monad instance provides a convenient way to combine streams in different ways. It is just non-determinism with different flavors of-scheduling behavior.  The example from the previous section can be run-with interleaved scheduling behavior as follows, without changing the-code at all:+scheduling behavior. The scheduling behavior can be controlled as follows.  ```haskell-main = Stream.drain $ Stream.fromWserial loops+bindWSerialK = StreamK.bfsConcatFor+bindWSerial a f = StreamK.toStream $ bindWSerialK (StreamK.fromStream a) (StreamK.fromStream . f)+$(mkCrossType "WSerialT" "bindWSerial" True)++loopsWSerial :: Stream IO ()+loopsWSerial = unWSerialT $ do+    x <- WSerialT $ Stream.fromList [1,2]+    y <- WSerialT $ Stream.fromList [3,4]+    WSerialT $ Stream.fromEffect $ print (x, y) ```  Scheduling is fundamental to expressing many common programming problems@@ -159,6 +184,9 @@  The same combinators that are used for serial streams e.g. 'unfoldrM', 'replicateM', 'repeatM' work concurrently when used at the appropriate type.++There are several concurrent combinators in streamly which are prefixed with+`par`. These combinators fit into the default composition very cleanly. It allows concurrent programs to be written declaratively and composed idiomatically. They are not much different than serial programs.  See [Streamly vs async](/docs/User/HowTo/streamly-vs-async.md)@@ -168,18 +196,33 @@ [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and [Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative style.  The list transformer example can be run with concurrent-execution of loop iterations as follows, without changing the code at-all:+execution of loop iterations as follows:  ```haskell-main = Stream.drain $ Stream.fromAhead loops+bindAhead :: MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b+bindAhead = flip (Stream.parConcatMap (Stream.ordered True))+$(mkCrossType "AheadT" "bindAhead" True)++loopsAhead :: Stream IO ()+loopsAhead = unAheadT $ do+    x <- AheadT $ Stream.fromList [1,2]+    y <- AheadT $ Stream.fromList [3,4]+    AheadT $ Stream.fromEffect $ print (x, y) ```  And interleaving with concurrent execution of the loop iterations can be written like this:  ```haskell-main = Stream.drain $ Stream.fromWAsync loops+bindWAsync :: MonadAsync m => Stream m a -> (a -> Stream m b) -> Stream m b+bindWAsync = flip (Stream.parConcatMap (Stream.interleaved True))+$(mkCrossType "WAsyncT" "bindWAsync" True)++loopsWAsync :: Stream IO ()+loopsWAsync = unWAsyncT $ do+    x <- WAsyncT $ Stream.fromList [1,2]+    y <- WAsyncT $ Stream.fromList [3,4]+    WAsyncT $ Stream.fromEffect $ print (x, y) ```  All this comes with no change in the streaming APIs.
docs/User/HowTo/Compiling.md view
@@ -4,9 +4,15 @@  ### Compiler (GHC) Versions -Do not use ghc 9.0.x and 9.2.1. GHC 9.6.x may have a small memory-leak issue in some concurrent stream cases, see below for more details.-For best performance use `fusion-plugin` (see below) when compiling.+1. Do not use ghc 8.2 or earlier because in those versions it is not+   safe to pass heap allocated objects to unsafe FFI calls. We depend on this+   for array implementation.+2. Do not use ghc 9.0.x and 9.2.1 becuse of performance issues. GHC 9.6.x may+   have a small memory leak issue in some concurrent stream cases,+   see below for more details. ghc 9.10 shows significant performance+   degradations, should not be used until it is fixed.++For best performance, use `fusion-plugin` (see below) when compiling.  ### Memory requirements 
@@ -1,1 +0,0 @@-https://github.com/composewell/streamly-examples
docs/User/HowTo/faq.md view
@@ -1,8 +1,8 @@ # Frequently Asked Questions  This document provides idioms or examples to solve common programming-problems using streamly. To start with please go through [Streamly Quick-Overview](/docs/User/Tutorials/quick-overview.md) and [`Streamly examples repository`][streamly-examples].+problems using streamly. To start with please go through the [Learn By+Examples](/docs/User/Tutorials/learn-by-examples.md) page and [`Examples Package`](https://github.com/composewell/streamly-examples). This document provides additional examples.  ## Distribute and Zip Concurrently@@ -13,41 +13,45 @@  Distributing a value to a stream of consumers concurrently: -```haskell ghci-{-# LANGUAGE FlexibleContexts #-}--import Data.Function ((&))-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Data.Stream.Prelude as Stream+```haskell docspec+>>> :set -XFlexibleContexts+>>> import Data.Function ((&))+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream.Prelude as Stream +>>> :{ f1 x =     Stream.fromList [return . (+ 1), return . (+ 2)] -- Stream of functions         & fmap ($ x)                                 -- Stream of lazy actions         & Stream.parSequence (Stream.ordered True)   -- Evaluate concurrently         & Stream.fold Fold.toList                    -- Fold to list+:} ``` -Use `parApply` to zip streams concurrently. Here, we zip three singleton+Use `parZipWith` to zip streams concurrently. Here, we zip three singleton streams: -```haskell ghci-+```haskell docspec+>>> :{ f2 x =-  let app = Stream.parApply id+  let app = Stream.parZipWith id ($)   in (,,)       `fmap` Stream.fromEffect (return $ show x)       `app`  Stream.fromEffect (return $ x + 1)       `app`  Stream.fromEffect (return $ fromIntegral x / 2)   & Stream.fold Fold.one+:} ```  Applying a function concurrently to your input stream: -```haskell ghci+```haskell docspec+>>> :{ g f xs =   Stream.fromList xs     & Stream.parMapM (Stream.ordered True) f     & Stream.fold Fold.toList+:} ```  You can now use the concurrent map to pipe each element through multiple@@ -61,31 +65,34 @@ [Just ("1",2,0.5),Just ("2",3,1.0),Just ("3",4,1.5),Just ("4",5,2.0)] ``` -Instead of using `parApply` directly, you can use `mkZipType` to+Instead of using `parZipWith` directly, you can use `mkZipType` to create a zip Applicative newtype so that you can use the `Applicative` instance.  ```haskell-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-} -import Streamly.Internal.Data.Stream.TypeGen+import Control.Monad.Trans.Control (MonadBaseControl)+import Streamly.Data.Stream.Prelude (MonadAsync, Stream)+import qualified Streamly.Data.Stream.Prelude as Stream+import Streamly.Data.Stream.MkType -app = parApply id-$(mkZippingType "ZipConcurrent" "app" True)+app :: MonadAsync m => Stream m (a -> b) -> Stream m a -> Stream m b+app = Stream.parZipWith id ($)+$(mkZipType "ZipConcurrent" "app" True) ```  ## Sliding Window -The `writeLastN` fold can be used to create a stream of sliding windows.+The `createOfLast` fold can be used to create a stream of sliding windows.  ```haskell docspec+>>> :set -Wno-deprecations >>> import qualified Streamly.Data.Array as Array >>> :{   Stream.fromList [1,2,3,4,5::Int]-& Stream.scan (Array.writeLastN 2)+& Stream.scan (Array.createOfLast 2) & Stream.fold Fold.toList :} [fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]
docs/User/HowTo/optimizing.md view
@@ -1,7 +1,23 @@-# Optimization Guide+# Haskell Streamly Optimization Guide -## Performance Optimizations+See also the streamly developer's optimization guide. +## When to Optimize?++Focus on performance only where it truly matters. Avoid optimizing+everything blindly—concentrate on the *fast path* or the parts of the+code that run most frequently. Optimizing rarely executed code offers+little benefit and can introduce unnecessary complexity. Prioritize the+hot spots where performance gains will have the greatest impact.++It’s important to be deliberate and informed about what to+optimize. Many developers fall into the trap of over-optimizing+unimportant code, while overlooking bottlenecks that actually impact+performance. Strive to profile first, understand the real costs, and+then optimize where it makes a measurable difference.++## Loop Optimizations: Stream Fusion+ A "closed loop" is any streamly code that generates a stream using unfold (or conceptually any stream generation combinator) and ends up eliminating it with a fold (conceptually any stream elimination@@ -9,35 +25,52 @@ a stream sequence, just like a `for` or `while` loop in imperative programming. -Closed loops are generated in a modular fashion by stream generation,+Closed loops are synthesized in a modular fashion by stream generation, transformation and elimination combinators in streamly. Combinators transfer data to the next stream pipeline stage using data constructors. These data constructors are eliminated by the compiler using `stream-fusion` optimizations, generating a very efficient loop.+fusion` optimizations, generating a very efficient loop. Streamly is designed+to utilize the stream fusion opitmization to the fullest such that the loops+are highly optimized providing similar performance as hand written C. -However, stream fusion optimization depends on proper inlining of the-combinators involved. The fusion-plugin package mentioned earlier-fills gaps for several optimizations that GHC does not perform-automatically. It automatically inlines the internal definitions+### Fusion Plugin++Stream fusion optimization depends on proper inlining of the combinators+involved. To take full advantage of stream fusion in streamly you should+compile your code with the `fusion-plugin` enabled. The fusion-plugin+package fills the gaps for several optimizations that GHC does not+perform automatically. It automatically inlines the internal definitions that involve the constructors we want to eliminate. In some cases fusion-plugin may not help and programmer may have to annotate the code-manually for complete fusion. In this section we mention some of the-cases where programmer annotation may help in stream fusion.+manually for complete fusion. -Remember, you need to worry about performance only where it matters, try-to optimize the fast path and not everything blindly.+In the following sections we mention some of the cases where programmer+annotation may help in stream fusion. -### INLINE annotations+### INLINE Annotations -It may help to add INLINE annotations on any intermediate functions-involved in a closed loop. In some cases you may have to add an inline-phase as well as described below.+It can be helpful to add `INLINE` annotations to intermediate functions+involved in a closed loop. In some cases, you may also need to specify+an `INLINE` phase, as discussed in the following sections. -Usually GHC has three inline phases - the first phase is pahse-2, the-second phase is phase-1 and the last one is phase-0.+As a rule of thumb, any function that takes `Stream`, `Fold`, or+`Unfold` types as arguments — or returns these types — should be+inlined. -#### Early INLINE+GHC typically uses three inline phases: +- **Phase 2** (the earliest),+- **Phase 1**, and+- **Phase 0** (the latest).++Inlining can be controlled with phase-specific annotations like:+``` haskell+{-# INLINE [1] functionName #-}+```+to guide when inlining occurs during compilation.++### Early INLINE+ Generally, you only have to inline the combinators or functions participating in a loop and not the whole loop itself.  But sometimes you may want to inline the whole loop itself inside a larger@@ -53,7 +86,7 @@ not very common but may be needed sometimes. Perhaps GHC can be fixed or we can resolve this using fusion-plugin in future. -#### Delayed INLINE+### Delayed INLINE  When a function is passed to a higher order function e.g. a function passed to `concatMap` or `unfoldMany` then we want the function to be@@ -61,23 +94,468 @@ higher order function can occur. For such cases we usually add INLINE[1] on the function being passed to instruct GHC not to inline it too early. -### Strictness annotations+## Chunked Processing (Inner and Outer Loops) +Processing data in larger chunks can significantly reduce loop overhead+by minimizing the number of iterations. Chunked processing enables the+inner loop to run more efficiently through stream fusion—reducing+heap allocations, improving cache locality, minimizing branching, and+enhancing opportunities for vectorization.++In libraries like *streamly*, this can be achieved by streaming arrays+and applying a fused operation to each array—either using built-in+combinators or writing custom logic per chunk. Whether the **outer+loop** is fused or not is usually less important, so you can choose+either the fused `Stream` type or the more flexible CPS-based `StreamK`+type.++However, for the **inner loop**, fusion is more critical, especially+when it runs frequently. To achieve this, you should prefer using+`Unfold` or fused `Stream` operations for chunk processing. Likewise, on+the consumer side, it's recommended to use the fused `Fold` or `Parser`+types to maintain performance.++This chunking strategy is especially effective in performance-critical+applications, such as numerical computing or high-throughput data+processing.++## When Fusion Matters++In stream processing, **fusion is most important in inner loops**—the+parts of your program that run most frequently. Outer loops, which are+executed less often, can afford to use non-fused combinators without+significant performance penalties.++Some operations in Streamly explicitly break fusion. These are clearly+annotated in the documentation. It's best to place such fusion-breaking+operations in the outer loop to keep the fast path—the inner+loop—fully fused and efficient.++That said, breaking fusion doesn't always have a noticeable performance+impact. The cost is primarily proportional to the number of loop+iterations. For example:++- A stream of 1,000 items, each 1KB in size, will likely show negligible+impact from a fusion break.+- A stream of 1 million items, each just 1 byte, will suffer+significantly—even though the total data volume is the same—because+the loop runs far more times.++This overhead arises from copying intermediate structures when fusion is+broken. The more iterations, the greater the cumulative cost.++In imperative programming, it's easier to see this: the loop body+is explicit, and the number of iterations is obvious. In stream+abstractions, however, the loop is hidden, making it harder to notice+when fusion matters.++Think of a fused stream as a **superhighway** for data processing. A+fusion break is like a **toll booth** or **junction** where each item+pays a small tax. Whether that toll matters depends on how much load you are+carrying per trip.++To give you a rough idea: let's assume the overhead of breaking fusion is+around **30–50 nanoseconds per item**. If you're processing something+like a database row and the processing takes a few microseconds per+item, this overhead is negligible—less than 0.05% of the total+cost. But if you're doing lightweight processing—say, ~100ns per+item—the toll becomes significant.++In general:  **Optimize the core processing first. Once that’s+efficient, look at fusion.**++## Breaking fusion: Monad binds++If fusion matters it is always good to have function having a type `...+-> Stream m a` instead of `... -> m (Stream m a)`. The first one is a+stream that can fuse with other streams, whereas the second is a monadic+action that returns a stream, the monadic action needs to be flattened+e.g. using `concatEffect` to generate a stream. Also, note that since+fusion breaks anyway inlining a function returning a `m (Stream m a)`+may not matter as much from fusion perspective.++The simple rule is that you do not break a stream pipeline to perform+an action and return the stream from the monad. If you do that then you+are deliberately breaking a fused pipeline. You need to compose all the+stream functions without cutting the pipeline by sandwiching a monadic+effect. Stream has an underlying monad and you should use available+stream combinators to perform any action in that monad and not outside+of the stream.++## Breaking Fusion: Monad Binds++When fusion performance matters, it's generally better to use functions +of type `... -> Stream m a` rather than `... -> m (Stream m a)`.++The former creates a stream directly, allowing it to fuse seamlessly+with other stream operations. The latter wraps the stream in a monadic+action, requiring an additional step—such as `concatEffect`—to+flatten it into a stream, which breaks fusion.++Guiding Principle:+Avoid interrupting a fused stream pipeline with monadic effects that+return new streams. Doing so effectively breaks the pipeline, making it+harder for the compiler to optimize and fuse subsequent operations.++Instead, try to express all effects within the stream itself. Streamly+provides combinators that work inside the stream’s underlying monad,+allowing you to stay within the fused pipeline. Use those to perform+effects without stepping outside the streaming abstraction.++## `concatMap` vs `unfoldEach`++As mentioned in the previous section, `concatEffect` belongs to the+class of `concatMap`-style operations. These operations do **not**+fuse, because they generate streams *dynamically* at runtime. Since the+structure of the resulting stream isn't statically known, the compiler+cannot apply fusion optimizations effectively.++To achieve full fusion in nested streams, use the `unfoldEach` family+of operations instead. These operate with statically known structure,+allowing the compiler to completely fuse the inner and outer loops. This+results in highly optimized code with minimal allocation and maximum+performance.++## Breaking Fusion: Stream Conversion++The `Stream` type in Streamly is fully fused—operations on it can+be composed without allocating intermediate structures. However,+when converting a `Stream` to or from other stream types—such as+the CPS-based `StreamK`, or third-party libraries like `streaming`,+`conduit`, or `pipes`—fusion is broken.++Such conversions involve exiting the fused pipeline and constructing+a new stream representation. This results in allocation of new data+constructors and loss of compiler optimizations that rely on the fusible+stream structure.++While interoperation with other libraries is sometimes necessary,+it's important to be aware that converting stream types introduces+overhead. To preserve fusion and maximize performance, stay within the+fused `Stream` type whenever possible.++## Strictness annotations+ * Strictness annotations on data, specially the data used as accumulator in   folds and scans, can help in improving performance. * Strictness annotations on function arguments can help the compiler unbox   constructors in certain cases, improving performance. * Sometimes using `-XStrict` extension can help improve performance, if so you   may be missing some strictness annotations. `-XStrict` can be used as an aid-  to detect missing annotations, using it blindly may regress performance.+  to detect missing annotations, but using it blindly may regress performance. -### Use tail recursion+## Use tail recursion -Do not use a strict `foldr` or lazy `foldl` unless you know what you are-doing.  Use lazy `foldr` for lazily transforming the stream and strict-`foldl` for reducing the stream.  If you are manually writing recursive-code, try to use tail recursion where possible.+If you are manually writing recursive code, try to use tail recursion+where possible. When using recursion via fold operations, do not use a+strict `foldr` or a lazy `foldl` unless you know what you are doing.+Always use lazy `foldr` for lazily transforming the stream and strict+`foldl` for reducing the stream. In streamly, this comes naturally as+the stream operations are lazy foldr like and the fold operations via+the Fold module are strict foldl like. +## Static Argument Transformation++Static Argument Transformation (SAT) is a valuable optimization for+reducing unnecessary overhead in recursive loops. It becomes especially+impactful when other inefficiencies have already been addressed.++GHC includes support for SAT via the `-fstatic-argument-transformation`+flag, which is enabled with the `-O2` optimization level. However, it+may not always trigger automatically or optimally in all cases.++For this reason, it's recommended that programmers understand and apply+this transformation manually when appropriate. Fortunately, it's simple+to do by habit, and in practice, we've observed substantial performance+improvements from applying it by hand in certain critical code paths.++See the `loopDir` function in [this example](https://github.com/composewell/streamly-examples/blob/ebf9470ce2e96f9882653bb1e0ae1b1a239487e3/examples/BasicDirStream.hsc)+for a case where static argument transformation was used to acheive+performance equivalent to C.++<!--+It will be nice if compiler can automatically detect and point out such+opportunities instead of doing it, the programmer can do it selectively.+-->++## Using `SpecConstr` in Recursive Loops++Consider leveraging the `SpecConstr` optimization when writing recursive+loops manually, this happens automatically when recursion is implemented+using combinators from streamly e.g. using streams or folds. By passing the+`SPEC` argument, you can guide GHC to specialize the loop based on the+constructor of the argument being threaded through the recursion.++This can lead to significant performance improvements in certain cases,+especially when the recursive argument has a known or predictable+constructor.++Understanding when and why this helps requires some familiarity with how+`SpecConstr` works internally. If you understand the mechanics of this+optimization, you'll be better equipped to spot opportunities where it+can make a real difference.++## Reducing Duplicate Branches++Duplicating branches in conditional expressions is a common pattern+in Haskell. This often occurs because an `if` expression in Haskell+**requires both** a `then` and an `else` branch.++In contrast, languages like C allow a series of single-branch `if`+statements, followed by a common operation. In Haskell, programmers+often end up duplicating that common operation in each `else` branch.++### Better Approaches++Instead of duplicating code:++- **Use `when`** from `Control.Monad` for single-branch conditions where+there's no `else`. This avoids unnecessary duplication.+- **Extract common code** into a `let` binding. This ensures the code is+only written once and reused across branches.++### Example++Instead of:++``` haskell+if condition1+  then doSomething1+  else doCommonThing++if condition2+  then doSomething2+  else doCommonThing+```++Refactor to:++``` haskell+    when condition1 doSomething1+    when condition2 doSomething2+    doCommonThing+```++Or, if multiple branches share a computation:++``` haskell+    let common = doCommonThing+    in if condition+         then doSomething >> common+         else doSomethingElse >> common+```++Using shared definitions not only improves readability and+maintainability but also reduces code bloat and allows the compiler to+optimize common expressions more effectively.++## Delay the Specialization++Suppose we want to choose between two functions, `f` and `g`, based on+a flag. One option is to make this decision early and pass the chosen+(inner) function to other parts of the code (outer). Another option is+to pass the flag itself and defer the decision until inside the outer+function that needs it.++In many cases, **delaying the decision**—i.e., passing the flag—is+preferable. This makes it easier for the compiler to optimize, since it+doesn't need to inline the outer function in order to inline the inner+one. By postponing specialization, the code stays more flexible and+often performs better, especially in larger or more abstract codebases.++## Reduce Allocations++One useful way to gauge whether an optimization is effective is by+measuring memory allocations. Most optimizations work by reducing the+number of allocations, though some CPU-focused optimizations may not.++Fewer allocations result in lower CPU utilization and reduced GC+pressure. In general, when writing code, keep in mind how it will be+translated by the compiler, and aim to be frugal with allocations.++<!--+Our GHC perf patch can help in precisely pin-pointing the places where+more allocations are happening.++TODO: static analyzer for allocations. GHC support to statically calculate the+allocations in different parts of the code.++AI like optimizations. Try different ways of optimizing the code and choose the+one with least allocations. Do or don't do a particular optimization based on+the context, e.g. exitify in some cases helps but in other cases it makes+things worse. We can make it learn the cases using training.+-->++## Mutable Memory in Local Loops++Using mutable memory in local loops can improve performance+significantly due to better cache utilization and reduced allocations+and garbage collection overhead. Instead of repeatedly allocating and+deallocating memory, we can reuse the same memory buffer.++For example, consider a print buffer that's copied during the print+operation. Rather than allocating and freeing the buffer on each+iteration, we can use a mutable buffer that persists across loop+iterations. This avoids unnecessary heap traffic.++Haskell currently lacks ergonomic abstractions for mutable memory, which+is a gap that should be addressed. However, we can still use low-level+tools like `allocaBytes` to allocate pinned mutable memory within a+loop.++In C, local memory is typically allocated on the stack, which is+automatically and efficiently deallocated as the function returns. In+contrast, Haskell makes minimal use of the stack—most allocations+occur on the heap. While heap allocation in Haskell can be as cheap+as in C, deallocation involves garbage collection, which introduces+overhead. To mitigate this, we can simulate stack-like behavior using+reusable mutable buffers, improving performance in performance-critical+code.++Interestingly, in multithreaded programs, Haskell may have an advantage:+each C thread requires a dedicated stack (with potential memory limits),+whereas Haskell uses the heap for all memory needs, avoiding stack-size+constraints. This makes memory use in Haskell more flexible and often+more efficient in highly concurrent applications.++See the `loopDir0` function in [this example](https://github.com/composewell/streamly-examples/blob/ebf9470ce2e96f9882653bb1e0ae1b1a239487e3/examples/BasicDirStream.hsc)+for a case where a mutable `buffer` is passed to the function which is+reused in each iteration of the loop to avoid unnecessary allocation+work to achieve performance equivalent to C.++## `unsafePerformIO`++When using `unsafePerformIO`, you should almost always add the+`NOINLINE` pragma. Without it, the compiler may inline the expression,+potentially duplicating side effects or violating assumptions about+evaluation order—leading to unsafe or unpredictable behavior. It can+also result in reduced performance.++``` haskell+    {-# NOINLINE myGlobal #-}+    myGlobal :: IORef Int+    myGlobal = unsafePerformIO (newIORef 0)+```++Using `NOINLINE` ensures that the `IO` action is performed only once,+helping preserve referential transparency as much as possible when+working with `unsafePerformIO`.++### File IO++Avoid using the standard file read/write functions from the `base`+library, as they are not optimized for performance. Instead, prefer+`streamly`’s file IO operations, which are significantly more+efficient—especially for high-throughput or streaming applications.++Alternatively, if you’re not using `streamly`, consider the lazy+`ByteString` or `Text`-based file IO functions from the `bytestring`+and `text` libraries. These provide better performance than the default+`String`-based APIs in `base`.++## Accumulating Folds vs Streaming++Consider the following fold function a Streamly user wanted to use for+stream processing:++``` haskell+    runQueryFold+      :: QueryRunner columns haskells+      -> Postgres.Connection+      -> Query columns+      -> b+      -> (b -> haskells -> IO b)+      -> IO b+```++This function starts with an initial value `b`, repeatedly applies+the step function `(b -> haskells -> IO b)`, and finally returns the+accumulated result `b`.++The user proposed to use this fold to build a stream, then process that+stream—for example:++``` haskell+    runQueryFold conn q StreamK.nil $ \xs x -> pure $ StreamK.cons x xs+```++This approach is counter-productive. The fold above runs an IO loop+that *accumulates* all input elements into a stream in memory before+returning it. The memory consumption grows proportionally with input+size, so for infinite or very large inputs, this will lead to memory+exhaustion.++### Why This Is a Problem++This is *not* how streaming is intended to be used. Streaming is+for *on-the-fly* processing, not accumulation. Instead of building+the entire stream first and then consuming it, the generation and+consumption should happen simultaneously in the same loop. This way,+each element is processed as soon as it is generated, keeping memory+usage constant regardless of input size.++Streaming operations are part of a *generate-transform-eliminate*+loop, fused together for efficiency. In each iteration, one element is+generated, processed by subsequent stream operations (like `map` or+`fold`), and then the loop continues with the next element.++### Proper Streaming Pipeline++To use streaming properly in this context, you can lift a step-wise+generation function into a stream with `unfoldrM`. For example, if your+generation logic provides a step function returning `Maybe` values, you+can convert it into a stream like this:++``` haskell+    Stream.unfoldrM step  -- generate step in the pipeline+      & Stream.mapM transform  -- transform step+      & ...                   -- additional stream operations+      & Stream.fold Fold.drain  -- eliminate step+```++This way, the entire pipeline remains fused, processes elements+incrementally, and avoids accumulating the entire input in memory.++<!--+Need to provide exact way how folds can be used in this context. Specifically,+in the step part of the runQueryFold we can run a Fold one input at a time and+return the Fold. Thus the type b would actually be a `Fold m haskells b`.++### Using Consumer Stream++The signature of the function `runQueryFold` tells us that it wants you+to do all the processing in the `b -> haskells -> IO b` step and only+return a final value `b` after the entire processing is done.++If you want to use this function and compose your processing in a+streaming manner then you have to essentially compose your streams as+part of the step of this function itself. And, you can do that very well+using the Fold type in streamly. Fold is basically like Stream but it is+consumer side stream rather than producer side stream.++You can lift the `runQueryFold` function into a streaming `Fold` using:++``` haskell+foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b+```++Then you can use routines from the Fold module to compose and process+the stream. Fold and Stream provide you equivalent functionality, they+just compose in opposite manner.+-->++## Streamly Specific Optimizations++### `fold` vs `foldBreak`++`fold` and `foldBreak` provide two different ways to consume a+stream. We can compose the cosumer folds into a single `Fold` type and+then run it using `fold`. Alternatively, we can use `foldBreak` to run+individual folds on the stream and get back the remaining stream each+time, then run the next fold on the remaining stream. For streams that+use a mutable state e.g. a stream from a file handle or a socket, the+`foldBreak` method may turn out to be more efficient.+ ## Build times and space considerations  Haskell, being a pure functional language, confers special powers on@@ -96,3 +574,10 @@ modules moving some non-inlined parts in another module. There is another advantage of breaking large modules, it can take advantage of parallel compilation if they do not depend on each other.++## perf-lint++A `perf-lint` tool is planned as part of the roadmap to help automate+many of these performance optimizations. The goal is to provide+actionable feedback on common performance pitfalls and suggest+improvements—similar to how `hlint` works for general code style.
docs/User/HowTo/streamly-vs-async.md view
@@ -48,11 +48,12 @@ Use the following imports to run the snippets shown below:  ```haskell-import Streamly-import Streamly.Prelude ((|:))-import qualified Streamly.Prelude as S+import qualified Streamly.Data.Stream.Prelude as S+import qualified Streamly.Data.Fold as F import qualified Data.Text as Text import Control.Concurrent (threadDelay)+import Control.Exception (Exception, SomeException)+import Control.Monad.Catch (throwM, try) ```  Let us simulate a URL fetch with a delay of `n` seconds using the following@@ -71,7 +72,7 @@ concurrently:  ```haskell-  urls <- S.toList $ fromParallel $ getURL 2 |: getURL 1 |: S.nil+getUrlsConcurrently = S.parSequence id $ S.fromList [getURL 2, getURL 1] ```  This would return the results in their arrival order i.e. first 1 and then 2.@@ -81,7 +82,7 @@ return 2 first and then 1.  ```haskell-  urls <- S.toList $ fromAhead $ getURL 2 |: getURL 1 |: S.nil+getUrlsOrdered = S.parSequence (S.ordered True) $ S.fromList [getURL 2, getURL 1] ```  ### concurrently_@@ -89,18 +90,17 @@ Use `drain` instead of `toList` to run the actions but ignore the results:  ```haskell-  S.drain $ fromParallel $ getURL 1 |: getURL 2 |: S.nil+drainUrlsConcurrently = S.fold F.drain $ S.parMapM id getURL $ S.fromList [1, 2] ``` -### Concurrent Applicative+### Concurrent Zipping  If the actions that you are executing result in different output types you can-use applicative zip to collect the results or to directly apply them to a-function:+use zip to collect the results or to directly apply them to a function:  ```haskell-  tuples <- S.toList $ fromZipAsync $-              (,) <$> S.fromEffect (getURLString 1) <*> S.fromEffect (getURLText 2)+concurrentZipping =+    S.parZipWith id (,) (S.fromEffect (getURLString 1)) (S.fromEffect (getURLText 2)) ```  ### race@@ -114,14 +114,14 @@ arrives:  ```haskell-  urls <- S.toList $ S.take 1 $ fromParallel $ getURL 1 |: getURL 2 |: S.nil+fastest = S.toList $ S.take 1 $ S.parSequence id $ S.fromList [getURL 1, getURL 2] ```  After the first result arrives, the rest of the actions are canceled automatically.  In general, we can take first `n` results as they arrive:  ```haskell-  urls <- S.toList $ S.take 2 $ fromParallel $ getURL 1 |: getURL 2 |: S.nil+fastestN n = S.toList $ S.take n $ S.parSequence id $ S.fromList [getURL 1, getURL 2] ```  #### `race` Using Exceptions@@ -133,54 +133,38 @@ other actions will be canceled, for example:  ```haskell-  data Result = Result String deriving Show-  instance Exception Result+data Result = Result String deriving Show+instance Exception Result -  main = do-      url <- try $ S.drain $ fromParallel $-                   (getURL 2 >>= throwM . Result)-                |: (getURL 1 >>= throwM . Result)-                |: S.nil-      case url of-          Left (e :: SomeException) -> print e-          Right _ -> undefined+raceUsingExceptions = do+    url <- try $ S.fold F.drain $ S.parSequence id $ S.fromList+               [ (getURL 2 >>= throwM . Result)+               , (getURL 1 >>= throwM . Result)+               ]+    case url of+        Left (e :: SomeException) -> print e+        Right _ -> undefined ```  ### mapConcurrently -There are many ways to map concurrently on a container and collect the results:--You can create a concurrent stream from a `Foldable` container of monadic-actions:--```haskell-  urls <- S.toList $ fromAhead $ S.fromFoldableM $ fmap getURL [1..3]-```--You can first convert a `Foldable` into a stream and then map an action on the-stream concurrently:--```haskell-  urls <- S.toList $ fromAhead $ S.mapM getURL $ foldMap return [1..3]-```--You can map a monadic action to a `Foldable` container to convert it into a-stream and at the same time fold it:+There are many ways to map concurrently on a container and collect the results.+The recommended way is to first convert itinto a stream and then map an action+on the stream concurrently:  ```haskell-  urls <- S.toList $ fromAhead $ foldMap (S.fromEffect . getURL) [1..3]+mapConcurrently = S.toList $ S.parMapM id getURL $ S.fromList [1..3] ```  ### replicateConcurrently  Streamly has not just the equivalent of `replicateConcurrently` which is-`replicateM` but many more ways to generate concurrent streams, for example,-`|:`, `unfoldrM`, `repeatM`, `iterateM`, `fromFoldableM` etc. See the-[Streamly.Prelude](https://hackage.haskell.org/package/streamly/docs/Streamly-Prelude.html)-module documentation for more details.+`parReplicateM` but many more ways to generate concurrent streams, for example,+`parRepeatM`, `parBuffered`, etc. See the `Streamly.Data.Stream.Prelude` module+documentation for more details.  ```haskell-  xs <- S.toList $ fromParallel $ S.replicateM 2 $ getURL 1+replicateConcurrently = S.toList $ S.parReplicateM id 2 $ getURL 1 ```  ### Functor@@ -191,14 +175,15 @@ To map serially just use `fmap`:  ```haskell-  xs <- S.toList $ fromParallel $ fmap (+1) $ return 1 |: return 2 |: S.nil+serialMap = S.toList $ fmap (+1) (S.fromList [1, 2] :: S.Stream IO Int)+ ``` -To map a monadic action concurrently on all elements of the stream use `mapM`:+To map a monadic action concurrently on all elements of the stream use `parMapM`:  ```haskell-  xs <- S.toList $ fromParallel $ S.mapM (\x -> return (x + 1))-                           $ return 1 |: return 2 |: S.nil+concurrentMap =+    S.toList $ S.parMapM id (\x -> pure (x + 1) :: IO Int) $ S.fromList [1, 2] ```  ### Semigroup
docs/User/HowTo/streamly-vs-lists.md view
@@ -22,12 +22,16 @@ lists can be used in a streaming style processing. For example, this is streaming style processing: -```-  replicate 10 1+```haskell docspec+>>> import Data.Function ((&))+>>> :{+replicate 10 1     & zipWith (+) [1..10]     & map (+1)     & filter odd     & sum+:}+35 ```  However, if a list is generated in a strict monad (e.g. IO) it cannot be@@ -37,12 +41,16 @@ large lists. For example, the following code accumulates `xs` before it processes it: -```-  xs <- replicateM 10 (return 1)-  zipWith (+) [1..10] xs+```haskell docspec+>>> import Control.Monad (replicateM)+>>> xs <- replicateM 10 (return 1)+>>> :{+zipWith (+) [1..10] xs     & map (+1)     & filter odd     & sum+:}+35 ```  Monadic streams solve this problem. To be able to consume elements from@@ -52,12 +60,17 @@ same API.  So we can represent the previous example in a streaming fashion by replacing the list combinators with corresponding streamly combinators: -```-  S.replicateM 10 (return 1)+```haskell docspec+>>> import qualified Streamly.Data.Stream as S+>>> import qualified Streamly.Data.Fold as F+>>> :{+S.replicateM 10 (return 1)     & S.zipWith (+) (S.fromList [1..10])-    & S.map (+1)+    & fmap (+1)     & S.filter odd-    & S.sum+    & S.fold F.sum+:}+35 ```  Streamly's monadic streams are a generalization of pure streams (aka lists) and@@ -66,7 +79,7 @@  ## Streamly as lists -`SerialT Identity a` can be used in place of `[a]` with equivalent or better+`Stream Identity a` can be used in place of `[a]` with equivalent or better performance and almost identical interface except a few differences. Use of `OverloadedLists` extension can make the difference even less significant. @@ -75,20 +88,19 @@  Lists are constructed using `[]` and `:`. -```-> "hello" : "world" : []+```haskell docspec+>>> "hello" : "world" : [] ["hello","world"] ```  Pure streams are constructed using `S.nil` (corresponds to `[]`) and `S.cons` or `.:` (corresponds to `:`): -```-import Streamly-import Streamly.Prelude ((.:))-import qualified Streamly.Prelude as S--> "hello" .: "world" .: S.nil :: SerialT Identity String+```haskell docspec+>>> import Data.Functor.Identity (Identity)+>>> import Streamly.Data.StreamK (StreamK)+>>> import qualified Streamly.Data.StreamK as StreamK+>>> "hello" `StreamK.cons` "world" `StreamK.cons` StreamK.nil :: StreamK Identity String fromList ["hello","world"] ``` @@ -97,34 +109,44 @@ The crucial difference is that lists are built using constructors whereas streams are built using functions. `S.nil` and `S.cons` are functions. Therefore, you cannot directly pattern match on streams.  However, the yet-unexposed `Streamly.List` module also provides `Nil` and `Cons` pattern-synonyms corresponding to the list `[]` and `:` constructors for pattern+unexposed `Streamly.Internal.Data.List` module also provides `Nil` and `Cons`+pattern synonyms corresponding to the list `[]` and `:` constructors for pattern matches.  ### Pure Operations -`SerialT Identity a` is an instance of `Show`, `Read`, `Eq`, `Ord`, `IsList`,-`Foldable` and `Traversable` type classes. Furthermore, `SerialT Identity Char`+`Stream Identity a` is an instance of `Show`, `Read`, `Eq`, `Ord`, `IsList`,+`Foldable` and `Traversable` type classes. Furthermore, `Stream Identity Char` is an instance of `IsString`. Use of `OverloadedLists` and `OverloadedStrings` can make the use of streams in place of lists quite convenient. -Along with these we can use combinators from `Streamly.Prelude` to perform all-list operations on pure streams.+Along with these we can use combinators from `Streamly.Data.Stream` to perform+all list operations on pure streams.  Lists: -```-> replicate 10 1-> map (+1) $ replicate 10 1-> length $ replicate 10 1+```haskell docspec+>>> replicate 10 1+[1,1,1,1,1,1,1,1,1,1]++>>> map (+1) $ replicate 10 1+[2,2,2,2,2,2,2,2,2,2]++>>> length $ replicate 10 1+10 ```  Pure streams are almost identical:  ```-> S.replicate 10 1 :: SerialT Identity Int-> S.map (+1) $ S.replicate 10 1 :: SerialT Identity Int-> length (S.replicate 10 1 :: SerialT Identity Int)+>>> S.replicate 10 1 :: S.Stream Identity Int+fromList [1,1,1,1,1,1,1,1,1,1]++>>> S.map (+1) $ S.replicate 10 1 :: S.Stream Identity Int+fromList [2,2,2,2,2,2,2,2,2,2]++>>> S.fold F.length (S.replicate 10 1 :: S.Stream Identity Int)+10 ```  ## Monadic Operations@@ -142,8 +164,9 @@ Unsafe monadic operations involving lists, run these example with `+RTS -s` options: -```+```haskell unshared import Control.Monad+ main = do   xs <- replicateM 10000000 (pure 1)   ys <- mapM (\x -> return $ x + 1) xs@@ -152,11 +175,12 @@  Streams: -```-import Streamly-import qualified Streamly.Prelude as S+```haskell unshared+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Fold as F+ main = do-  n <- S.length+  n <- S.fold F.length       $ S.mapM (\x -> return $ x + 1)       $ S.replicateM 10000000 (pure 1)   print n@@ -176,16 +200,15 @@ Monadic streams are nothing but lists made monadic. We can construct streams using monadic actions, just the way pure lists are constructed: +<!-- We are not type checking this --> ```-> import Streamly.Prelude ((|:))-> import qualified Streamly.Prelude as S-> S.toList $ getLine |: getLine |: S.nil+>>> import qualified Streamly.Data.StreamK as StreamK+>>> StreamK.toList $ getLine `StreamK.cons` getLine `StreamK.cons` StreamK.nil hello world ["hello","world"] ``` -`|:` is the monadic construction equivalent of `:`. The monadic action `getLine` is executed twice in a sequence, the first one gets "hello" and second one gets "world" from the terminal and a stream consisting of those strings is produced.@@ -199,38 +222,40 @@  The following code prints one element every second: -```haskell-import Control.Concurrent-import Streamly-import qualified Streamly.Prelude as S+```haskell docspec+>>> import Control.Concurrent+>>> import qualified Streamly.Data.Stream.Prelude as S+>>> import qualified Streamly.Data.Fold as F -func = S.mapM (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1-main = runStream func+>>> func = S.mapM (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1+>>> main = S.fold F.drain func ``` -To run it concurrently, just run the same code with `fromAsync` combinator:+To run it concurrently, depending on what you want to make concurrent, you can+use `parMapM` or `parBuffered`. -```haskell-main = runStream $ fromAsync func+```haskell docspec+>>> func = S.parMapM id (\x -> threadDelay 1000000 >> print x) $ S.replicate 10 1+>>> main = S.fold F.drain func ``` -The `mapM` combinator now maps the monadic delay action concurrently on all the-stream elements.  It prints all the 10 elements after one second because all+The `parMapM` combinator now maps the monadic delay action concurrently on all+the stream elements.  It prints all the 10 elements after one second because all the delay actions run concurrently. Alternatively we can write: -```-func = S.mapM $ fromAsync $ S.replicateM (threadDelay 1000000 >> print 1)-main = runStream func+```haskell docspec+>>> func = S.parReplicateM id 10 (threadDelay 1000000 >> print 1)+>>> main = S.fold F.drain func ``` -Here, the `replicateM` operation replicates the action concurrently.  In real+Here, the `parReplicateM` operation replicates the action concurrently.  In real applications this could be a request to a web server that you may want to perform multiple times concurrently.  ## Performance: Streamly vs Lists  The following figures show the ratio of time and memory consumed by `[Int]`-(`base-4.12`) vs `SerialT Identity Int`+(`base-4.12`) vs `Stream Identity Int` ([streamly@00c7613](https://github.com/composewell/streamly)) for exactly the same operation. `5x` on the y axis means lists take 5 times more resources compared to streamly. Whereas a `1/5x` means that lists take 5 times less
+ docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt view
@@ -0,0 +1,261 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Data.Stream.Prelude+    [A] useAcquire :: AcquireIO -> Config -> Config+    [D] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parCrossApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [D] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] clearAcquire :: Config -> Config+[A] Streamly.Data.Scanl.Prelude+    [A] Config+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Scanl m x a -> Scanl m x b -> Scanl m x c+    [A] parDistributeScanM :: MonadAsync m => (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDemuxScanM :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Scanl m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> Scanl m a b) -> Stream m a -> Stream m [(k, b)]+    [A] maxBuffer :: Int -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] boundThreads :: Bool -> Config -> Config+[C] Streamly.Data.Fold.Prelude+    [C] toHashMapIO+        [O] toHashMapIO :: (MonadIO m, Hashable k, Ord k) => (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+        [N] toHashMapIO :: (MonadIO m, Hashable k) => (a -> k) -> Fold m a b -> Fold m a (HashMap k b)+    [A] parUnzip :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b, c) (x, y)+    [A] parTee :: MonadAsync m => (Config -> Config) -> Fold m x a -> Fold m x b -> Fold m x (a, b)+    [A] parPartition :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+    [D] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+    [A] parDistribute :: MonadAsync m => (Config -> Config) -> [Fold m a b] -> Fold m a [b]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Fold m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Network.Inet.TCP+    [A] pipeChunks :: (MonadAsync m, MonadCatch m) => (Word8, Word8, Word8, Word8) -> PortNumber -> Stream m (Array Word8) -> Stream m (Array Word8)+[D] Streamly.Internal.FileSystem.Event.Linux+[D] Streamly.Internal.FileSystem.Event+[C] Streamly.Internal.Data.Stream.Prelude+    [C] Channel+        [C] [enqueue]+            [O] [enqueue] :: Channel m a -> Bool -> (RunInIO m, StreamK m a) -> IO ()+            [N] [enqueue] :: Channel m a -> (RunInIO m, StreamK m a) -> IO ()+        [A] [channelStopping] :: Channel m a -> IORef Bool+        [A] [channelStopped] :: Channel m a -> MVar Bool+        [C] Channel+            [O] Channel :: RunInIO m -> IORef ([ChildEvent a], Int) -> MVar () -> m [ChildEvent a] -> m Bool -> Limit -> Limit -> Maybe (IORef Count) -> Maybe YieldRateInfo -> (Bool -> (RunInIO m, StreamK m a) -> IO ()) -> m () -> IO Bool -> IO Bool -> IORef Bool -> (Maybe WorkerInfo -> m ()) -> IORef (Set ThreadId) -> IORef Int -> (ThreadId -> m ()) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a+            [N] Channel :: RunInIO m -> Limit -> IORef ([ChildEvent a], Int) -> MVar () -> m [ChildEvent a] -> m Bool -> Maybe (IORef Count) -> IO Bool -> Maybe YieldRateInfo -> IORef Bool -> m () -> ((RunInIO m, StreamK m a) -> IO ()) -> IO Bool -> (Maybe WorkerInfo -> m ()) -> IORef Bool -> MVar Bool -> Limit -> IORef (Set ThreadId) -> IORef Int -> (ThreadId -> m ()) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a+    [A] yieldWith :: Maybe WorkerInfo -> Channel m a -> a -> IO Bool+    [R] yield :: Channel m a -> Maybe WorkerInfo -> a -> IO Bool+    [A] useAcquire :: AcquireIO -> Config -> Config+    [A] timedGroupsOf :: MonadAsync m => Double -> Int -> Fold m a b -> Stream m a -> Stream m b+    [A] timedChunksOf' :: (MonadAsync m, Unbox a) => Double -> Int -> Stream m a -> Stream m (Array a)+    [A] timedChunksOf :: (MonadAsync m, Unbox a) => Double -> Int -> Stream m a -> Stream m (Array a)+    [A] stopWith :: Maybe WorkerInfo -> Channel m a -> IO ()+    [R] stopChannel :: MonadIO m => Channel m a -> m ()+    [R] stop :: Channel m a -> Maybe WorkerInfo -> IO ()+    [C] startChannel+        [O] startChannel :: MonadRunInIO m => Channel m a -> m ()+        [N] startChannel :: MonadIO m => Channel m a -> m ()+    [A] shutdown :: MonadIO m => Channel m a -> m ()+    [R] sendWorkerWait :: MonadIO m => Bool -> (Channel m a -> IO ()) -> (Channel m a -> m Bool) -> Channel m a -> m ()+    [C] readOutputQPaced+        [O] readOutputQPaced :: MonadRunInIO m => Channel m a -> m [ChildEvent a]+        [N] readOutputQPaced :: MonadIO m => Channel m a -> m [ChildEvent a]+    [C] readOutputQBounded+        [O] readOutputQBounded :: MonadRunInIO m => Bool -> Channel m a -> m [ChildEvent a]+        [N] readOutputQBounded :: MonadIO m => Bool -> Channel m a -> m [ChildEvent a]+    [R] pushWorker :: MonadRunInIO m => Count -> Channel m a -> m ()+    [C] postProcessPaced+        [O] postProcessPaced :: MonadRunInIO m => Channel m a -> m Bool+        [N] postProcessPaced :: MonadIO m => Channel m a -> m Bool+    [C] postProcessBounded+        [O] postProcessBounded :: MonadRunInIO m => Channel m a -> m Bool+        [N] postProcessBounded :: MonadIO m => Channel m a -> m Bool+    [A] parYieldWith :: (Config -> Config) -> ((a -> m b) -> m c) -> Stream m a+    [A] parMergeMap :: (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+    [A] parMergeIterate :: (Config -> Config) -> (a -> Stream m a) -> Stream m a -> Stream m a+    [D] parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [A] parCrossApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+    [D] parApply :: MonadAsync m => (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b+    [A] newStreamAndCallback :: MonadAsync m => m (a -> m (), Stream m a)+    [A] newRateInfo :: Config -> IO (Maybe YieldRateInfo)+    [A] maxYields :: Maybe Int64 -> Config -> Config+    [D] groupsOfTimeout :: MonadAsync m => Int -> Double -> Fold m a b -> Stream m a -> Stream m b+    [A] getYieldLimit :: Config -> Maybe Count+    [A] getStreamRate :: Config -> Maybe Rate+    [A] getOrdered :: Config -> Bool+    [A] getMaxThreads :: Config -> Limit+    [A] getMaxBuffer :: Config -> Limit+    [A] getInterleaved :: Config -> Bool+    [A] getInspectMode :: Config -> Bool+    [A] getEagerDispatch :: Config -> Bool+    [A] getCleanup :: Config -> Maybe (IO () -> IO ())+    [C] fromChannelK+        [O] fromChannelK :: MonadAsync m => Channel m a -> StreamK m a+        [N] fromChannelK :: MonadAsync m => Maybe (IO () -> IO ()) -> Channel m a -> StreamK m a+    [A] forkWorker :: MonadIO m => Count -> Channel m a -> m ()+    [A] exceptionWith :: Maybe WorkerInfo -> Channel m a -> SomeException -> IO ()+    [R] dumpSVar :: Channel m a -> IO String+    [A] dumpChannel :: Channel m a -> IO String+    [C] dispatchWorkerPaced+        [O] dispatchWorkerPaced :: MonadRunInIO m => Channel m a -> m Bool+        [N] dispatchWorkerPaced :: MonadIO m => Channel m a -> m Bool+    [C] dispatchWorker+        [O] dispatchWorker :: MonadRunInIO m => Count -> Channel m a -> m Bool+        [N] dispatchWorker :: MonadIO m => Count -> Channel m a -> m Bool+    [A] dispatchAllWait :: MonadIO m => Bool -> (Channel m a -> IO ()) -> (Channel m a -> m Bool) -> Channel m a -> m ()+    [A] clearAcquire :: Config -> Config+    [A] cleanupChan :: Channel m a -> String -> IO ()+    [A] channelDone :: Channel m a -> String -> IO ()+    [A] chanConcatMapK :: MonadAsync m => (Config -> Config) -> Channel m b -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] boundedIntervalsOf :: Int -> Double -> Int -> Fold m a b -> Stream m a -> Stream m b+    [A] boundThreads :: Bool -> Config -> Config+[A] Streamly.Internal.Data.Scanl.Prelude+    [A] OutEvent+        [A] FoldPartial :: b -> OutEvent b+        [A] FoldException :: ThreadId -> SomeException -> OutEvent b+        [A] FoldEOF :: ThreadId -> OutEvent b+        [A] FoldDone :: ThreadId -> b -> OutEvent b+    [A] Config+    [A] Channel+        [A] [svarStats] :: Channel m a b -> SVarStats+        [A] [svarRef] :: Channel m a b -> Maybe (IORef ())+        [A] [svarInspectMode] :: Channel m a b -> Bool+        [A] [svarCreator] :: Channel m a b -> ThreadId+        [A] [readInputQ] :: Channel m a b -> m [ChildEvent a]+        [A] [outputQueue] :: Channel m a b -> IORef ([OutEvent b], Int)+        [A] [outputDoorBell] :: Channel m a b -> MVar ()+        [A] [maxInputBuffer] :: Channel m a b -> Limit+        [A] [inputSpaceDoorBell] :: Channel m a b -> MVar ()+        [A] [inputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+        [A] [inputItemDoorBell] :: Channel m a b -> MVar ()+        [A] [closedForInput] :: Channel m a b -> IORef Bool+        [A] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> IORef Bool -> MVar () -> m [ChildEvent a] -> IORef ([OutEvent b], Int) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+    [A] sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+    [A] sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Scanl m x a -> Scanl m x b -> Scanl m x c+    [A] parDistributeScanM :: MonadAsync m => (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+    [A] parDemuxScanM :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Scanl m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> Scanl m a b) -> Stream m a -> Stream m [(k, b)]+    [A] newScanChannel :: MonadRunInIO m => (Config -> Config) -> Scanl m a b -> m (Channel m a b)+    [A] newChannelWithScan :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Scanl m a b -> m (Channel m a b, ThreadId)+    [A] newChannelWith :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Fold m a b -> m (Channel m a b, ThreadId)+    [A] newChannel :: MonadRunInIO m => (Config -> Config) -> Fold m a b -> m (Channel m a b)+    [A] maxBuffer :: Int -> Config -> Config+    [A] inspect :: Bool -> Config -> Config+    [A] finalize :: MonadIO m => Channel m a b -> m ()+    [A] dumpChannel :: Channel m a b -> IO String+    [A] defaultConfig :: Config+    [A] cleanup :: MonadIO m => Channel m a b -> m ()+    [A] checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)+    [A] boundThreads :: Bool -> Config -> Config+[C] Streamly.Internal.Data.Fold.Prelude+    [A] OutEvent+        [A] FoldPartial :: b -> OutEvent b+        [A] FoldException :: ThreadId -> SomeException -> OutEvent b+        [A] FoldEOF :: ThreadId -> OutEvent b+        [A] FoldDone :: ThreadId -> b -> OutEvent b+    [C] Channel+        [R] [readOutputQ] :: Channel m a b -> m [ChildEvent a]+        [A] [readInputQ] :: Channel m a b -> m [ChildEvent a]+        [C] [outputQueue]+            [O] [outputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+            [N] [outputQueue] :: Channel m a b -> IORef ([OutEvent b], Int)+        [R] [outputQueueFromConsumer] :: Channel m a b -> IORef ([ChildEvent b], Int)+        [R] [outputDoorBellFromConsumer] :: Channel m a b -> MVar ()+        [A] [maxInputBuffer] :: Channel m a b -> Limit+        [R] [maxBufferLimit] :: Channel m a b -> Limit+        [A] [inputSpaceDoorBell] :: Channel m a b -> MVar ()+        [A] [inputQueue] :: Channel m a b -> IORef ([ChildEvent a], Int)+        [A] [inputItemDoorBell] :: Channel m a b -> MVar ()+        [A] [closedForInput] :: Channel m a b -> IORef Bool+        [R] [bufferSpaceDoorBell] :: Channel m a b -> MVar ()+        [C] Channel+            [O] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> m [ChildEvent a] -> IORef ([ChildEvent b], Int) -> MVar () -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+            [N] Channel :: IORef ([ChildEvent a], Int) -> Limit -> MVar () -> IORef Bool -> MVar () -> m [ChildEvent a] -> IORef ([OutEvent b], Int) -> MVar () -> Maybe (IORef ()) -> SVarStats -> Bool -> ThreadId -> Channel m a b+    [A] sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+    [A] parUnzipWithM :: MonadAsync m => (Config -> Config) -> (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+    [A] parUnzip :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b, c) (x, y)+    [A] parTeeWith :: MonadAsync m => (Config -> Config) -> (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+    [A] parTee :: MonadAsync m => (Config -> Config) -> Fold m x a -> Fold m x b -> Fold m x (a, b)+    [A] parPartition :: MonadAsync m => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+    [A] parLmapM :: (Config -> Config) -> (a -> m b) -> Fold m b r -> Fold m a r+    [D] parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] parDistributeScan :: MonadAsync m => (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+    [A] parDistribute :: MonadAsync m => (Config -> Config) -> [Fold m a b] -> Fold m a [b]+    [A] parDemuxScan :: (MonadAsync m, Ord k) => (Config -> Config) -> (a -> k) -> (k -> m (Fold m a b)) -> Stream m a -> Stream m [(k, b)]+    [A] parBuffered :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+    [A] newScanChannel :: MonadRunInIO m => (Config -> Config) -> Scanl m a b -> m (Channel m a b)+    [A] newChannelWithScan :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Scanl m a b -> m (Channel m a b, ThreadId)+    [A] newChannelWith :: MonadRunInIO m => IORef ([OutEvent b], Int) -> MVar () -> (Config -> Config) -> Fold m a b -> m (Channel m a b, ThreadId)+    [A] finalize :: MonadIO m => Channel m a b -> m ()+    [R] dumpSVar :: Channel m a b -> IO String+    [A] dumpChannel :: Channel m a b -> IO String+    [A] defaultConfig :: Config+    [A] cleanup :: MonadIO m => Channel m a b -> m ()+[C] Streamly.Internal.Data.Channel+    [C] YieldRateInfo+    [R] Config+    [R] workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+    [R] stopWhen :: StopWhen -> Config -> Config+    [R] setStreamLatency :: Int -> Config -> Config+    [C] sendYield+        [O] sendYield :: Limit -> Limit -> IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Bool+        [N] sendYield :: Limit -> Limit -> IORef Int -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> Maybe WorkerInfo -> a -> IO Bool+    [R] sendWithDoorBell :: IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Int+    [C] sendStop+        [O] sendStop :: IORef Int -> Maybe WorkerInfo -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> IO ()+        [N] sendStop :: IORef Int -> Maybe YieldRateInfo -> IORef ([ChildEvent a], Int) -> MVar () -> Maybe WorkerInfo -> IO ()+    [A] sendException :: IORef Int -> IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+    [A] sendEvent :: IORef ([a], Int) -> MVar () -> a -> IO Int+    [C] readOutputQBasic+        [O] readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+        [N] readOutputQBasic :: IORef ([a], Int) -> IO ([a], Int)+    [R] rate :: Maybe Rate -> Config -> Config+    [R] ordered :: Bool -> Config -> Config+    [R] newRateInfo :: Config -> IO (Maybe YieldRateInfo)+    [R] minRate :: Double -> Config -> Config+    [R] maxYields :: Maybe Int64 -> Config -> Config+    [R] maxThreads :: Int -> Config -> Config+    [R] maxRate :: Double -> Config -> Config+    [R] maxBuffer :: Int -> Config -> Config+    [R] interleaved :: Bool -> Config -> Config+    [R] inspect :: Bool -> Config -> Config+    [A] incrWorkerYieldCount :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool+    [R] handleChildException :: IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()+    [R] getYieldLimit :: Config -> Maybe Count+    [R] getStreamRate :: Config -> Maybe Rate+    [R] getStreamLatency :: Config -> Maybe NanoSecond64+    [R] getStopWhen :: Config -> StopWhen+    [R] getOrdered :: Config -> Bool+    [R] getMaxThreads :: Config -> Limit+    [R] getMaxBuffer :: Config -> Limit+    [R] getInterleaved :: Config -> Bool+    [R] getInspectMode :: Config -> Bool+    [R] getEagerDispatch :: Config -> Bool+    [R] getBound :: Config -> Bool+    [R] eager :: Bool -> Config -> Config+    [R] defaultConfig :: Config+    [R] constRate :: Double -> Config -> Config+    [R] cleanupSVar :: IORef (Set ThreadId) -> IO ()+    [R] boundThreads :: Bool -> Config -> Config+    [R] avgRate :: Double -> Config -> Config
+ docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt view
@@ -0,0 +1,253 @@+# API diff as generated by cabal-diff with minor edits.+# ~~~ means deprecated module+# ~~ means deprecated symbol++#----------------------------+# Changes from 0.7.3 to 0.8.0+#----------------------------++# Deprecated, merged into Streamly.Prelude+~~~ Streamly+# Fixity changes+++ infixr 6 `ahead`+++ infixr 6 `async`+++ infixr 6 `parallel`+++ infixr 6 `serial`+++ infixr 6 `wAsync`+++ infixr 6 `wSerial`++# Added+@@@ Streamly.Console.Stdio++# Deprecated, renamed+~~~ Streamly.Memory.Array+@@@ Streamly.Data.Array.Foreign++# Moved from Streamly.Memory.Array+++ data Array a+++ fromList :: Storable a => [a] -> Array a+++ fromListN :: Storable a => Int -> [a] -> Array a+++ length :: forall a. Storable a => Array a -> Int+++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ toList :: Storable a => Array a -> [a]+++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)+++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)++# Added+++ asBytes :: Array a -> Array Word8+++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)+++ getIndex :: Storable a => Array a -> Int -> Maybe a+++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a+++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)++@@@ Streamly.Data.Fold+# Signature changed+ - product :: (Monad m, Num a) => Fold m a a+ + product :: (Monad m, Num a, Eq a) => Fold m a a++# Removed (Moved to the Streamly.Data.Fold.Tee module)+-- instance (Monad m, Floating b) => Floating (Fold m a b)+-- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)+-- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)+-- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)+-- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)+-- instance Applicative m => Applicative (Fold m a)++# Renamed+~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c+++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c++# Deprecated+~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b++# Added+++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b+++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c+++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r+++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r+++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b+++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b+++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b+++ lmap :: (a -> b) -> Fold m b r -> Fold m a r+++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r+++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r+++ rollingHash :: (Monad m, Enum a) => Fold m a Int64+++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64+++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a+++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ take :: Monad m => Int -> Fold m a b -> Fold m a b+++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+++ toListRev :: Monad m => Fold m a [a]++# Added+@@@ Streamly.Data.Fold.Tee++@@@ Streamly.Data.Unfold+# Added+++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+++ drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b+++ dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ fromList :: Applicative m => Unfold m [a] a+++ fromListM :: Applicative m => Unfold m [m a] a+++ fromStream :: (IsStream t, Applicative m) => Unfold m (t m a) a+++ function :: Applicative m => (a -> b) -> Unfold m a b+++ functionM :: Applicative m => (a -> m b) -> Unfold m a b+++ iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a+++ lmap :: (a -> c) -> Unfold m c b -> Unfold m a b+++ lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b+++ many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c+++ mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c+++ repeatM :: Monad m => Unfold m (m a) a+++ replicateM :: Monad m => Int -> Unfold m (m a) a+++ take :: Monad m => Int -> Unfold m a b -> Unfold m a b+++ takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+++ takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+++ unfoldr :: Applicative m => (a -> Maybe (b, a)) -> Unfold m a b+++ unfoldrM :: Applicative m => (a -> m (Maybe (b, a))) -> Unfold m a b+++ zipWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d++# Deprecated, renamed to Streamly.Unicode.Stream+~~~ Streamly.Data.Unicode.Stream++@@@ Streamly.Network.Socket+# Added+++ forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m ()+++ readChunk :: Int -> Socket -> IO (Array Word8)+++ writeChunk :: Storable a => Socket -> Array a -> IO ()+++ writeChunksWithBufferOf :: (MonadIO m, Storable a) => Int -> Socket -> Fold m (Array a) ()++@@@ Streamly.Prelude+# Signature changed+ - after :: (IsStream t, Monad m) => m b -> t m a -> t m a+ + after :: (IsStream t, MonadIO m, MonadBaseControl IO m) => m b -> t m a -> t m a+ - bracket :: (IsStream t, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a+ + bracket :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a+ - concatMapWith :: IsStream t => (forall c. t m c -> t m c -> t m c) -> (a -> t m b) -> t m a -> t m b+ + concatMapWith :: IsStream t => (t m b -> t m b -> t m b) -> (a -> t m b) -> t m a -> t m b+ - finally :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a+ + finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a+ - foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b+ + foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b+ - postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+ + postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b+ - scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b+ + scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b++# Renamed+~~ yieldM :: (Monad m, IsStream t) => m a -> t m a+++ fromEffect :: (Monad m, IsStream t) => m a -> t m a+~~ yield :: IsStream t => a -> t m a+++ fromPure :: IsStream t => a -> t m a+~~ concatUnfold :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b+++ unfoldMany :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b++# Moved from "Streamly" module+## Fixity change+++ infixr 6 `ahead`+++ infixr 6 `async`+++ infixr 6 `parallel`+++ infixr 6 `serial`+++ infixr 6 `wAsync`+++ infixr 6 `wSerial`+## Renamed+~~ foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a+++ concatFoldableWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a+~~ forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b+++ concatForFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b+~~ foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b+++ concatMapFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b+~~ aheadly :: IsStream t => AheadT m a -> t m a+++ fromAhead :: IsStream t => AheadT m a -> t m a+~~ asyncly :: IsStream t => AsyncT m a -> t m a+++ fromAsync :: IsStream t => AsyncT m a -> t m a+~~ parallely :: IsStream t => ParallelT m a -> t m a+++ fromParallel :: IsStream t => ParallelT m a -> t m a+~~ serially :: IsStream t => SerialT m a -> t m a+++ fromSerial :: IsStream t => SerialT m a -> t m a+~~ wAsyncly :: IsStream t => WAsyncT m a -> t m a+++ fromWAsync :: IsStream t => WAsyncT m a -> t m a+~~ wSerially :: IsStream t => WSerialT m a -> t m a+++ fromWSerial :: IsStream t => WSerialT m a -> t m a+~~ zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a+++ fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a+~~ zipSerially :: IsStream t => ZipSerialM m a -> t m a+++ fromZipSerial :: IsStream t => ZipSerialM m a -> t m a+## unchanged+++ class (forall m a. MonadAsync m => Semigroup (t m a), forall m a. MonadAsync m => Monoid (t m a), forall m. Monad m => Functor (t m), forall m. MonadAsync m => Applicative (t m)) => IsStream t+++ data AheadT m a+++ data AsyncT m a+++ data ParallelT m a+++ data Rate Rate :: Double -> Double -> Double -> Int -> Rate+++ data SerialT m a+++ data WAsyncT m a+++ data WSerialT m a+++ data ZipAsyncM m a+++ data ZipSerialM m a+++ type Ahead = AheadT IO+++ type Async = AsyncT IO+++ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)+++ type Parallel = ParallelT IO+++ type Serial = SerialT IO+++ type WAsync = WAsyncT IO+++ type WSerial = WSerialT IO+++ type ZipAsync = ZipAsyncM IO+++ type ZipSerial = ZipSerialM IO+++ (|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b+++ (|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b+++ (|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b+++ (|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b+++ [rateBuffer] :: Rate -> Int+++ [rateGoal] :: Rate -> Double+++ [rateHigh] :: Rate -> Double+++ [rateLow] :: Rate -> Double+++ adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a+++ ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ avgRate :: IsStream t => Double -> t m a -> t m a+++ constRate :: IsStream t => Double -> t m a -> t m a+++ maxBuffer :: IsStream t => Int -> t m a -> t m a+++ maxRate :: IsStream t => Double -> t m a -> t m a+++ maxThreads :: IsStream t => Int -> t m a -> t m a+++ minRate :: IsStream t => Double -> t m a -> t m a+++ mkAsync :: (IsStream t, MonadAsync m) => t m a -> t m a+++ parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ rate :: IsStream t => Maybe Rate -> t m a -> t m a+++ serial :: IsStream t => t m a -> t m a -> t m a+++ wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a+++ wSerial :: IsStream t => t m a -> t m a -> t m a++# Added+++ delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a+++ foldMany :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b+++ intercalate :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c+++ intercalateSuffix :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c+++ liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m)) => t m a -> t (tr m) a+++ runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a+++ runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)++# Removed: documentation moved to streamly-docs module in docs dir+@@@ Streamly.Tutorial++# Deprecated, renamed+~~~ Streamly.Data.Unicode.Stream+@@@ Streamly.Unicode.Stream+# Moved from Streamly.Data.Unicode.Stream+## Behavior changed+++ decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char+++ encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8+++ encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8+## Unchanged+++ decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char++# Added+++ decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char+++ encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8+++ encodeStrings :: (MonadIO m, IsStream t) => (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)+++ encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
+ docs/User/Project/ApiChangelogs/0.8.0-0.8.1.txt view
@@ -0,0 +1,11 @@+# API diff as generated by cabal-diff with minor edits.+# ~~~ means deprecated module+# ~~ means deprecated symbol++#----------------------------+# Changes from 0.8.0 to 0.8.1+#----------------------------++@@@ Streamly.FileSystem.Handle+++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)+++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()
− docs/User/Project/ApiChangelogs/0.8.3.txt 
@@ -1,261 +0,0 @@-# API diff as generated by cabal-diff with minor edits.-# ~~~ means deprecated module-# ~~ means deprecated symbol--#-----------------------------# Changes from 0.8.0 to 0.8.1-#------------------------------@@@ Streamly.FileSystem.Handle-++ getChunk :: MonadIO m => Int -> Handle -> m (Array Word8)-++ putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()--#-----------------------------# Changes from 0.7.3 to 0.8.0-#------------------------------# Deprecated, merged into Streamly.Prelude-~~~ Streamly-# Fixity changes-++ infixr 6 `ahead`-++ infixr 6 `async`-++ infixr 6 `parallel`-++ infixr 6 `serial`-++ infixr 6 `wAsync`-++ infixr 6 `wSerial`--# Added-@@@ Streamly.Console.Stdio--# Deprecated, renamed-~~~ Streamly.Memory.Array-@@@ Streamly.Data.Array.Foreign--# Moved from Streamly.Memory.Array-++ data Array a-++ fromList :: Storable a => [a] -> Array a-++ fromListN :: Storable a => Int -> [a] -> Array a-++ length :: forall a. Storable a => Array a -> Int-++ read :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ toList :: Storable a => Array a -> [a]-++ write :: forall m a. (MonadIO m, Storable a) => Fold m a (Array a)-++ writeN :: forall m a. (MonadIO m, Storable a) => Int -> Fold m a (Array a)--# Added-++ asBytes :: Array a -> Array Word8-++ cast :: forall a b. Storable b => Array a -> Maybe (Array b)-++ getIndex :: Storable a => Array a -> Int -> Maybe a-++ readRev :: forall m a. (Monad m, Storable a) => Unfold m (Array a) a-++ writeLastN :: (Storable a, MonadIO m) => Int -> Fold m a (Array a)--@@@ Streamly.Data.Fold-# Signature changed- - product :: (Monad m, Num a) => Fold m a a- + product :: (Monad m, Num a, Eq a) => Fold m a a--# Removed (Moved to the Streamly.Data.Fold.Tee module)--- instance (Monad m, Floating b) => Floating (Fold m a b)--- instance (Monad m, GHC.Num.Num b) => GHC.Num.Num (Fold m a b)--- instance (Monad m, GHC.Real.Fractional b) => GHC.Real.Fractional (Fold m a b)--- instance (Semigroup b, Monad m) => Semigroup (Fold m a b)--- instance (Semigroup b, Monoid b, Monad m) => Monoid (Fold m a b)--- instance Applicative m => Applicative (Fold m a)--# Renamed-~~ mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-++ rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c--# Deprecated-~~ sequence :: Monad m => Fold m a (m b) -> Fold m a b--# Added-++ catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-++ chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c-++ concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c-++ filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r-++ filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-++ foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b-++ foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b-++ foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b-++ lmap :: (a -> b) -> Fold m b r -> Fold m a r-++ lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r-++ many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-++ mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r-++ rollingHash :: (Monad m, Enum a) => Fold m a Int64-++ rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64-++ sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-++ serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ take :: Monad m => Int -> Fold m a b -> Fold m a b-++ takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b-++ teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-++ toListRev :: Monad m => Fold m a [a]--# Added-@@@ Streamly.Data.Fold.Tee--@@@ Streamly.Data.Unfold-# Added-++ crossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d-++ drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b-++ dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ fromList :: Applicative m => Unfold m [a] a-++ fromListM :: Applicative m => Unfold m [m a] a-++ fromStream :: (IsStream t, Applicative m) => Unfold m (t m a) a-++ function :: Applicative m => (a -> b) -> Unfold m a b-++ functionM :: Applicative m => (a -> m b) -> Unfold m a b-++ iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a-++ lmap :: (a -> c) -> Unfold m c b -> Unfold m a b-++ lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b-++ many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c-++ mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c-++ repeatM :: Monad m => Unfold m (m a) a-++ replicateM :: Monad m => Int -> Unfold m (m a) a-++ take :: Monad m => Int -> Unfold m a b -> Unfold m a b-++ takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b-++ takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b-++ unfoldr :: Applicative m => (a -> Maybe (b, a)) -> Unfold m a b-++ unfoldrM :: Applicative m => (a -> m (Maybe (b, a))) -> Unfold m a b-++ zipWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d--# Deprecated, renamed to Streamly.Unicode.Stream-~~~ Streamly.Data.Unicode.Stream--@@@ Streamly.Network.Socket-# Added-++ forSocketM :: (MonadMask m, MonadIO m) => (Socket -> m ()) -> Socket -> m ()-++ readChunk :: Int -> Socket -> IO (Array Word8)-++ writeChunk :: Storable a => Socket -> Array a -> IO ()-++ writeChunksWithBufferOf :: (MonadIO m, Storable a) => Int -> Socket -> Fold m (Array a) ()--@@@ Streamly.Prelude-# Signature changed- - after :: (IsStream t, Monad m) => m b -> t m a -> t m a- + after :: (IsStream t, MonadIO m, MonadBaseControl IO m) => m b -> t m a -> t m a- - bracket :: (IsStream t, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a- + bracket :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> (b -> m c) -> (b -> t m a) -> t m a- - concatMapWith :: IsStream t => (forall c. t m c -> t m c -> t m c) -> (a -> t m b) -> t m a -> t m b- + concatMapWith :: IsStream t => (t m b -> t m b -> t m b) -> (a -> t m b) -> t m a -> t m b- - finally :: (IsStream t, MonadCatch m) => m b -> t m a -> t m a- + finally :: (IsStream t, MonadAsync m, MonadCatch m) => m b -> t m a -> t m a- - foldlM' :: Monad m => (b -> a -> m b) -> b -> SerialT m a -> m b- + foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b- - postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b- + postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b- - scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> b -> t m a -> t m b- + scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b--# Renamed-~~ yieldM :: (Monad m, IsStream t) => m a -> t m a-++ fromEffect :: (Monad m, IsStream t) => m a -> t m a-~~ yield :: IsStream t => a -> t m a-++ fromPure :: IsStream t => a -> t m a-~~ concatUnfold :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b-++ unfoldMany :: (IsStream t, Monad m) => Unfold m a b -> t m a -> t m b--# Moved from "Streamly" module-## Fixity change-++ infixr 6 `ahead`-++ infixr 6 `async`-++ infixr 6 `parallel`-++ infixr 6 `serial`-++ infixr 6 `wAsync`-++ infixr 6 `wSerial`-## Renamed-~~ foldWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-++ concatFoldableWith :: (IsStream t, Foldable f) => (t m a -> t m a -> t m a) -> f (t m a) -> t m a-~~ forEachWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-++ concatForFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> f a -> (a -> t m b) -> t m b-~~ foldMapWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-++ concatMapFoldableWith :: (IsStream t, Foldable f) => (t m b -> t m b -> t m b) -> (a -> t m b) -> f a -> t m b-~~ aheadly :: IsStream t => AheadT m a -> t m a-++ fromAhead :: IsStream t => AheadT m a -> t m a-~~ asyncly :: IsStream t => AsyncT m a -> t m a-++ fromAsync :: IsStream t => AsyncT m a -> t m a-~~ parallely :: IsStream t => ParallelT m a -> t m a-++ fromParallel :: IsStream t => ParallelT m a -> t m a-~~ serially :: IsStream t => SerialT m a -> t m a-++ fromSerial :: IsStream t => SerialT m a -> t m a-~~ wAsyncly :: IsStream t => WAsyncT m a -> t m a-++ fromWAsync :: IsStream t => WAsyncT m a -> t m a-~~ wSerially :: IsStream t => WSerialT m a -> t m a-++ fromWSerial :: IsStream t => WSerialT m a -> t m a-~~ zipAsyncly :: IsStream t => ZipAsyncM m a -> t m a-++ fromZipAsync :: IsStream t => ZipAsyncM m a -> t m a-~~ zipSerially :: IsStream t => ZipSerialM m a -> t m a-++ fromZipSerial :: IsStream t => ZipSerialM m a -> t m a-## unchanged-++ class (forall m a. MonadAsync m => Semigroup (t m a), forall m a. MonadAsync m => Monoid (t m a), forall m. Monad m => Functor (t m), forall m. MonadAsync m => Applicative (t m)) => IsStream t-++ data AheadT m a-++ data AsyncT m a-++ data ParallelT m a-++ data Rate Rate :: Double -> Double -> Double -> Int -> Rate-++ data SerialT m a-++ data WAsyncT m a-++ data WSerialT m a-++ data ZipAsyncM m a-++ data ZipSerialM m a-++ type Ahead = AheadT IO-++ type Async = AsyncT IO-++ type MonadAsync m = (MonadIO m, MonadBaseControl IO m, MonadThrow m)-++ type Parallel = ParallelT IO-++ type Serial = SerialT IO-++ type WAsync = WAsyncT IO-++ type WSerial = WSerialT IO-++ type ZipAsync = ZipAsyncM IO-++ type ZipSerial = ZipSerialM IO-++ (|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> t m a -> t m b-++ (|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> t m a -> m b-++ (|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b-++ (|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b-++ [rateBuffer] :: Rate -> Int-++ [rateGoal] :: Rate -> Double-++ [rateHigh] :: Rate -> Double-++ [rateLow] :: Rate -> Double-++ adapt :: (IsStream t1, IsStream t2) => t1 m a -> t2 m a-++ ahead :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ async :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ avgRate :: IsStream t => Double -> t m a -> t m a-++ constRate :: IsStream t => Double -> t m a -> t m a-++ maxBuffer :: IsStream t => Int -> t m a -> t m a-++ maxRate :: IsStream t => Double -> t m a -> t m a-++ maxThreads :: IsStream t => Int -> t m a -> t m a-++ minRate :: IsStream t => Double -> t m a -> t m a-++ mkAsync :: (IsStream t, MonadAsync m) => t m a -> t m a-++ parallel :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ rate :: IsStream t => Maybe Rate -> t m a -> t m a-++ serial :: IsStream t => t m a -> t m a -> t m a-++ wAsync :: (IsStream t, MonadAsync m) => t m a -> t m a -> t m a-++ wSerial :: IsStream t => t m a -> t m a -> t m a--# Added-++ delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a-++ foldMany :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b-++ intercalate :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c-++ intercalateSuffix :: (IsStream t, Monad m) => Unfold m b c -> b -> t m b -> t m c-++ liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m)) => t m a -> t (tr m) a-++ runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a-++ runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)--# Removed: documentation moved to streamly-docs module in docs dir-@@@ Streamly.Tutorial--# Deprecated, renamed-~~~ Streamly.Data.Unicode.Stream-@@@ Streamly.Unicode.Stream-# Moved from Streamly.Data.Unicode.Stream-## Behavior changed-++ decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char-++ encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8-++ encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8-## Unchanged-++ decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char--# Added-++ decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char-++ encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8-++ encodeStrings :: (MonadIO m, IsStream t) => (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)-++ encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8
docs/User/Project/CONTRIBUTORS.md view
@@ -4,6 +4,15 @@ Use `git shortlog -sn tag1...tag2` on the git repository to get a list of contributors between two repository tags. +## 0.11.0++* Harendra Kumar+* Adithya Kumar+* Alice Rixte+* Domen Kožar+* He Zhenxing+* ericpashman+ ## 0.10.0  * Adithya Kumar
docs/User/Project/Changelog.md view
@@ -2,6 +2,33 @@  <!-- See rendered changelog at https://streamly.composewell.com --> +## 0.11.0++See+[0.10.1-0.11.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.11.0/docs/User/Project/ApiChangelogs/0.10.1-0.11.0.txt)+for detailed API changes in this release.++### Breaking Changes++* Concurrent streams and folds now use separate concurrency config types. If you+  were importing `Config` from the wrong module, you will need to update it.++### Enhancements++* Support for prompt cleanup of concurrent threads, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Introduced `Streamly.Data.Scanl.Prelude` for using concurrent+  operations with the new `Scanl` type. Scans can split a stream into+  multiple streams, process them concurrently, and merge the results.+* Added new concurrent fold combinators in `Streamly.Data.Fold.Prelude`.+* Fixed rate control for ordered streams.++### Internal++* Internal `FileSystem.Event.*` modules are deprecated; use the+  [streamly-fsevents](https://github.com/composewell/streamly-fsevents) package.+  instead.+ ## 0.10.1 (Jan 2024)  * Fix TH macros in `Streamly.Data.Stream.MkType` for GHC 9.6 and above.@@ -82,7 +109,7 @@ `StreamK` types can be easily interconverted.  The old code can be adapted to use the new modules with some changes.-See the +See the [streamly-0.9.0 Upgrade Guide](https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md) for more details on how to adapt your existing code to the new release. @@ -137,7 +164,7 @@  ## 0.8.1 (Nov 2021) -See ApiChangelogs/0.8.3.txt for new APIs introduced.+See ApiChangelogs/0.8.0-0.8.1.txt for new APIs introduced.  ### Bug Fixes @@ -165,7 +192,7 @@  ## 0.8.0 (Jun 2021) -See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of signature+See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of signature changes and new APIs introduced.  ### Breaking changes@@ -204,7 +231,7 @@  ### Enhancements -* See [API Changelog](/docs/User/Project/ApiChangelogs/0.8.3.txt) for a complete list of new+* See [API Changelog](/docs/User/Project/ApiChangelogs/0.7.3-0.8.0.txt) for a complete list of new   modules and APIs introduced. * The Fold type is now more powerful, the new termination behavior allows   to express basic parsing of streams using folds.
docs/User/Project/README.md view
@@ -1,6 +1,7 @@ # [Streamly][]: Idiomatic Haskell with C-Like Performance  [![Gitter chat](https://badges.gitter.im/composewell/gitter.svg)](https://gitter.im/composewell/streamly)+[![Hackage](https://img.shields.io/hackage/v/streamly-core.svg?style=flat)](https://hackage.haskell.org/package/streamly-core) [![Hackage](https://img.shields.io/hackage/v/streamly.svg?style=flat)](https://hackage.haskell.org/package/streamly)  ## Upgrading to 0.9.0+@@ -23,11 +24,9 @@ * Fearless, declarative concurrency for seamless parallel execution. * A collection of ecosystem libraries for fast and efficient development. -Check out the [Streamly Getting Started-Guide](/docs/User/Tutorials/getting-started.md) and [Quick-Overview](/docs/User/Tutorials/quick-overview.md) for an introduction-to the library. For more detailed documentation, visit the [Haskell-Streamly website][Streamly].+Check out the [Learn By Examples](/docs/User/Tutorials/learn-by-examples.md)+page for an introduction to the library. For more detailed documentation, visit+the [Haskell Streamly website][Streamly].  ## Blazing Fast @@ -94,7 +93,7 @@   * Gabriella Gonzalez ([foldl](https://hackage.haskell.org/package/foldl))   * Alberto G. Corona ([transient](https://hackage.haskell.org/package/transient)) -Please see the [`credits`](/docs/User/ProjectRelated/Credits.md) directory for a full+Please see the [`credits`](/docs/User/Project/Credits.md) directory for a full list of contributors, credits and licenses.  ## Licensing
docs/User/Project/Upgrading-0.8-to-0.9.md view
@@ -1,5 +1,9 @@ # Upgrading to streamly 0.9.0 +```haskell docspec+>>> :set -Wno-deprecations+```+ Also see the detailed changelog describing all the changes in the release:  * [0.9.0 API Changelog](/docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt) or@@ -281,12 +285,16 @@ >>> splitOn = Streamly.Internal.Data.Stream.splitOn >>> splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f) >>> indexedR = Streamly.Internal.Data.Stream.indexedR->>> groupsBy eq fld = Stream.parseMany (Parser.groupBy eq fld)+>>> groupsBy eq fld = Stream.parseMany (Parser.groupBy (flip eq) fld) >>> groups = groupsBy (==) >>> groupsByRolling = Streamly.Internal.Data.Stream.groupsRollingBy >>> wordsBy p f = Stream.parseMany (Parser.wordBy p f) >>> chunksOf n f = Stream.foldMany (Fold.take n f) ```++**Caution**: In `streamly-0.8`, The `groupsBy` comparison function took the new+element as the first argument and the previous element as the second.  The order+is flipped in the newer versions of streamly.  Direct implementation of these are also available in `Streamly.Internal.Data.Stream`.
− docs/User/Tutorials/ConcurrentStreams.hs 
@@ -1,771 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : User.Tutorials.ConcurrentStreams--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ THIS TUTORIAL IS OBSOLETE.------ In this tutorial we will show how streamly can be used for idiomatic and--- declarative concurrent programming.  Before you go through this tutorial we--- recommend that you take a look at the Streamly serial streams tutorial.--module User.Tutorials.ConcurrentStreams-    (-    -- * Imports-    -- $setup--    -- * Concurrent Streams-    -- $concurrentStreams--    -- * Combining Streams-    -- $flavors--    -- * Imports and Supporting Code-    -- $imports--    -- * Generating Streams Concurrently-    -- $generatingConcurrently--    -- * Concurrent Pipeline Stages-    -- $concurrentApplication--    -- * Mapping Concurrently-    -- $concurrentTransformation--    -- * Merging Streams--    -- ** Semigroup Style--    -- *** Deep Speculative Composition ('Ahead')-    -- $ahead--    -- *** Deep Asynchronous Composition ('Async')-    -- $async--    -- *** Wide Asynchronous Composition ('WAsync')-    -- $wasync--    -- *** Parallel Asynchronous Composition ('Parallel')-    -- $parallel--    -- XXX we should deprecate and remove the mkAsync API-    -- Custom composition-    -- custom--    -- ** Monoid Style-    -- $monoid--    -- * Nesting Streams--    -- ** Monad-    -- *** Deep Speculative Nesting ('Ahead')-    -- $aheadNesting--    -- *** Deep Asynchronous Nesting ('Async')-    -- $concurrentNesting--    -- *** Wide Asynchronous Nesting ('WAsync')-    -- $wasyncNesting--    -- *** Parallel Asynchronous Nesting ('Parallel')-    -- $parallelNesting--    -- ** Applicative-    -- $applicative--    -- * Zipping Streams--    -- ** Parallel Zipping-    -- $parallelzip--    -- * Concurrent Programming-    -- $concurrent--    -- * Writing Concurrent Programs-    -- $programs--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Data.Stream-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- CAUTION: please keep setup and imports sections in sync---- XXX This tutorial has to be rewritten.---- $setup--- In most of example snippets we do not repeat the imports. Where imports are--- not explicitly specified use the imports shown below.------ >>> :m--- >>> :set -fno-warn-deprecations--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------ To illustrate concurrent vs serial composition aspects, we will use the--- following @delay@ function to introduce a sleep or delay specified in--- seconds. After the delay it prints the number of seconds it slept.------ >>> import Control.Concurrent (threadDelay, myThreadId)--- >>> :{---   delay n = Stream.fromEffect $ do---      threadDelay (n * 1000000)---      tid <- myThreadId---      putStrLn (show tid ++ ": Delay " ++ show n)--- :}------ For concurrent examples, use line buffering, otherwise output from different--- threads may get mixed:------ >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))--- >>> hSetBuffering stdout LineBuffering------- $concurrentStreams------ Many stream operations can be done concurrently:------ * Streams can be generated concurrently.------ * Streams can be merged concurrently.------ * Multiple stages in a streaming pipeline can run concurrently.------ * Streams can be mapped and zipped concurrently.------ * In monadic composition they combine like a list transformer,---   providing concurrent non-determinism.------ There are three basic concurrent stream styles, 'Ahead', 'Async', and--- 'Parallel'. The 'Ahead' style streams are similar to 'Serial' except that--- they can speculatively execute multiple stream actions concurrently in--- advance. 'Ahead' would return exactly the same stream as 'Serial' except--- that it may execute the actions concurrently. The 'Async' style streams,--- like 'Ahead', speculatively execute multiple stream actions in advance but--- return the results in their finishing order rather than in the stream--- traversal order.  'Parallel' is like 'Async' except that it provides--- unbounded parallelism instead of controlled parallelism.------ For easy reference, we can classify the stream types based on /execution order/,--- /consumption order/, and /bounded or unbounded/ concurrency.--- Execution could be serial (i.e. synchronous) or asynchronous. In serial--- execution we execute the next action in the stream only after the previous--- one has finished executing. In asynchronous execution multiple actions in--- the stream can be executed asynchronously i.e. the next action can start--- executing even before the first one has finished. Consumption order--- determines the order in which the outputs generated by the composition are--- consumed.  Consumption could be serial or asynchronous. In serial--- consumption, the outputs are consumed in the traversal order, in--- asynchronous consumption the outputs are consumed as they arrive i.e. first--- come first serve order.------ +------------+--------------+--------------+--------------+--- | Type       | Execution    | Consumption  | Concurrency  |--- +============+==============+==============+==============+--- | 'Serial'   | Serial       | Serial       | None         |--- +------------+--------------+--------------+--------------+--- | 'Ahead'    | Asynchronous | Serial       | bounded      |--- +------------+--------------+--------------+--------------+--- | 'Async'    | Asynchronous | Asynchronous | bounded      |--- +------------+--------------+--------------+--------------+--- | 'Parallel' | Asynchronous | Asynchronous | unbounded    |--- +------------+--------------+--------------+--------------+------ All these types can be freely inter-converted using type conversion--- combinators or type annotations, without any cost, to achieve the desired--- composition style.  To force a particular type of composition, we coerce the--- stream type using the corresponding type adapting combinator from--- 'fromSerial', 'fromAhead', 'fromAsync', or 'fromParallel'.  The default stream type--- is inferred as 'Serial' unless you change it by using one of the combinators--- or by using a type annotation.---- $flavors------ Streams can be combined using '<>' or 'mappend' to form a--- composite. Composite streams can be interpreted in a depth first or--- breadth first manner using an appropriate type conversion before--- consumption. Deep (e.g. 'Serial') stream type variants traverse a--- composite stream in a depth first manner, such that each stream is--- traversed fully before traversing the next stream. Wide--- (e.g. 'WSerial') stream types traverse it in a breadth first--- manner, such that one element from each stream is traversed before--- coming back to the first stream again.------ Each stream type has a wide traversal variant prefixed by 'W'. The wide--- variant differs only in the Semigroup\/Monoid, Applicative\/Monad--- compositions of the streams.--- The following table summarizes the basic types and the corresponding wide--- variants:------ @--- +------------+-----------+--- | Deep       | Wide      |--- +============+===========+--- | 'Serial'     | 'WSerial'   |--- +------------+-----------+--- | 'Ahead'      | 'WAhead'    |--- +------------+-----------+--- | 'Async'      | 'WAsync'    |--- +------------+-----------+--- @------ Other than these types there are also 'ZipSerial' and 'ZipAsync' types that--- zip streams serially or concurrently using 'Applicative' operation. These--- types are not monads they are only applicatives and they do not differ in--- 'Semigroup' composition.------- $programs------ When writing concurrent programs it is advised to not use the concurrent--- style stream combinators blindly at the top level. That might create too--- much concurrency where it is not even required, and can even degrade--- performance in some cases. In some cases it can also lead to surprising--- behavior because of some code that is supposed to be serial becoming--- concurrent. Please be aware that all concurrency capable APIs that you may--- have used under the scope of a concurrent stream combinator will become--- concurrent. For example if you have a 'repeatM' somewhere in your program--- and you use 'fromParallel' on top, the 'repeatM' becomes fully parallel,--- resulting into an infinite parallel execution . Instead, use the--- /Keep It Serial and Stupid/ principle, start with the default serial--- composition and enable concurrent combinators only when and where necessary.--- When you use a concurrent combinator you can use an explicit 'fromSerial'--- combinator to suppress any unnecessary concurrency under the scope of that--- combinator.---- $generatingConcurrently------ Monadic construction and generation functions like 'consM', 'unfoldrM',--- 'replicateM', 'repeatM', 'iterateM' and 'fromFoldableM' work concurrently--- when used with appropriate stream type combinator. The pure versions of--- these APIs are not concurrent, however you can use the monadic versions even--- for pure computations by wrapping the pure value in a monad to get the--- concurrent generation capability where required.------ The following code finishes in 3 seconds (6 seconds when serial):------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> Stream.toList $ Stream.fromParallel $ p 3 |: p 2 |: p 1 |: Stream.nil--- [1,2,3]------ >>> Stream.toList $ Stream.fromAhead $ p 3 |: p 2 |: p 1 |: Stream.nil--- [3,2,1]------ The following finishes in 10 seconds (100 seconds when serial):------ >>> Stream.drain $ Stream.fromAsync $ Stream.replicateM 10 $ p 10------- $concurrentTransformation------ Monadic transformation functions 'mapM' and 'sequence' work concurrently--- when used with appropriate stream type combinators. The pure versions do not--- work concurrently, however you can use the monadic versions even for pure--- computations to get the concurrent transformation capability where required.------ This would print a value every second (2 seconds when serial):------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> :{--- parMap =---       Stream.repeatM (p 1)---     & Stream.fromSerial   -- repeatM is serial---     & Stream.mapM (\x -> p 1 >> print x)---     & Stream.fromAhead    -- mapM is cocnurrent using Ahead style---     & Stream.drain--- :}------- $concurrentApplication------ The concurrent function application operators '|$' and '|&' apply a stream--- argument to a stream function concurrently to compose a concurrent pipeline--- of stream processing functions:------ Because both the stages run concurrently, we would see a delay of only 1--- second instead of 2 seconds in the following:------ >>> let p n = threadDelay (n * 1000000) >> return n--- >>> :{--- parApp =---        Stream.repeatM (p 1)---     |& Stream.mapM (\x -> p 1 >> print x)---      & Stream.drain--- :}---- $ahead------ The 'Semigroup' operation '<>' of the 'Ahead' type combines two streams in a--- /serial depth first/ manner with concurrent lookahead. We use the 'fromAhead'--- type combinator to effect 'Ahead' style of composition. We can also use an--- explicit 'Ahead' type annotation for the stream to achieve the same effect.------ When two streams are combined in this manner, the streams are traversed in--- depth first manner just like 'Serial', however it can execute the next--- stream concurrently and keep the results ready when its turn arrives.--- Concurrent execution of the next stream(s) is performed if the first stream--- blocks or if it cannot produce output at the rate that is enough to meet the--- consumer demand. Multiple streams can be executed concurrently to meet the--- demand.  The following example would print the result in a second even--- though each action in each stream takes one second:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream1 = p 1 |: p 2 |: Stream.nil--- >>> stream2 = p 3 |: p 4 |: Stream.nil--- >>> Stream.toList $ Stream.fromAhead $ stream1 <> stream2--- [1,2,3,4]------ Each stream is constructed 'fromAhead' and then both the streams are merged--- 'fromAhead', therefore, all the actions can run concurrently but the result is--- presented in serial order.------ You can also use the polymorphic combinator 'ahead' in place of '<>' to--- compose any type of streams in this manner.---- $async------ The 'Semigroup' operation '<>' of the 'Async' type combines the two--- streams in a depth first manner with parallel look ahead. We use the--- 'fromAsync' type combinator to effect 'Async' style of composition. We--- can also use the 'Async' type annotation for the stream type to achieve--- the same effect.------ When two streams with multiple elements are combined in this manner, the--- streams are traversed in depth first manner just like 'Serial', however it--- can execute the next stream concurrently and return the results from it--- as they arrive i.e. the results from the next stream may be yielded even--- before the results from the first stream. Concurrent execution of the next--- stream(s) is performed if the first stream blocks or if it cannot produce--- output at the rate that is enough to meet the consumer demand. Multiple--- streams can be executed concurrently to meet the demand.--- In the example below each element in the stream introduces a constant delay--- of 1 second, however, it takes just one second to produce all the results.--- The results are not guaranteed to be in any particular order:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream1 = p 1 |: p 2 |: Stream.nil--- >>> stream2 = p 3 |: p 4 |: Stream.nil--- >>> Stream.toList $ Stream.fromAsync $ stream1 <> stream2--- ...------ The constituent streams are also composed in 'Async' manner and the--- composition of streams too. We can compose the constituent streams to run--- serially, in that case it would take 2 seconds to produce all the results.--- The elements in the serial streams would be in serial order in the results:------ >>> p n = threadDelay 1000000 >> return n--- >>> stream = (Stream.fromSerial stream1) <> (Stream.fromSerial stream2)--- >>> Stream.toList $ Stream.fromAsync stream--- ...------ In the following example we can see that new threads are started when a--- computation blocks.  Notice that the output from the stream with the--- shortest delay is printed first. The whole computation takes @maximum of--- (3, 2, 1) = 3@ seconds:------ >>> Stream.drain $ Stream.fromAsync $ delay 3 <> delay 2 <> delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ When we have a tree of computations composed using this style, the tree is--- traversed in DFS style just like the 'Serial' style, the only difference is--- that here we can move on to executing the next stream if a stream blocks.--- However, we will not start new threads if we have sufficient output to--- saturate the consumer.  This is why we call it left-biased demand driven or--- adaptive concurrency style, the concurrency tends to stay on the left side--- of the composition as long as possible. More threads are started based on--- the pull rate of the consumer. The following example prints an output every--- second as all of the actions are concurrent.------ >>> Stream.drain $ Stream.fromAsync $ (delay 1 <> delay 2) <> (delay 3 <> delay 4)--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- ThreadId ...: Delay 4------ All the computations may even run in a single thread when more threads are--- not needed. As you can see, in the following example the computations are--- run in a single thread one after another, because none of them blocks.--- However, if the thread consuming the stream were faster than the producer--- then it would have started parallel threads for each computation to keep up--- even if none of them blocks:------ >>> :{--- traced m = Stream.fromEffect (myThreadId >>= print) >> return m--- stream = traced (sqrt 9) <> traced (sqrt 16) <> traced (sqrt 25)--- main = Stream.drain $ Stream.fromAsync stream--- :}------ Note that the order of printing in the above examples may change due to--- variations in scheduling latencies for concurrent threads.------ The polymorphic version of the 'Async' binary operation '<>' is called--- 'async'. We can use 'async' to join streams in a left biased--- adaptively concurrent manner irrespective of the type, notice that we have--- not used the 'fromAsync' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.async` delay 2 `Stream.async` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Since the concurrency provided by this operator is demand driven it cannot--- be used when the composed computations start timers that are relative to--- each other because all computations may not be started at the same time and--- therefore timers in all of them may not start at the same time.  When--- relative timing among all computations is important or when we need to start--- all computations at once for any reason 'Parallel' style must be used--- instead.------ 'Async' style utilizes resources optimally and should be preferred over--- 'Parallel' or 'WAsync' unless you really need those. 'Async' should be used--- when we know that the computations can run in parallel but we do not care if--- they actually run in parallel or not, that decision can be left to the--- scheduler based on demand. Also, note that 'async' operator can be used to fold--- infinite number of streams in contrast to the 'Parallel' or 'WAsync' styles,--- because it does not require us to run all of them at the same time in a fair--- manner.---- $wasync------ The 'Semigroup' operation '<>' of the 'WAsync' type combines two streams in--- a concurrent manner using /breadth first traversal/. We use the 'fromWAsync'--- type combinator to effect 'WAsync' style of composition. We can also use the--- 'WAsync' type annotation for the stream to achieve the same effect.------ When streams with multiple elements are combined in this manner, we traverse--- all the streams concurrently in a breadth first manner i.e. one action from--- each stream is performed and yielded to the resulting stream before we come--- back to the first stream again and so on. Even though we execute the actions--- in a breadth first order the outputs are consumed on a first come first--- serve basis.------ In the following example we can see that outputs are produced in the breadth--- first traversal order but this is not guaranteed.------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ Stream.fromWAsync $ stream1 <> stream2--- 1--- 3--- 2--- 4------ The polymorphic version of the binary operation '<>' of the 'WAsync' type is--- 'wAsync'.  We can use 'wAsync' to join streams using a breadth first--- concurrent traversal irrespective of the type, notice that we have not used--- the 'fromWAsync' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.wAsync` delay 2 `Stream.wAsync` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Since the concurrency provided by this style is demand driven it may not--- be used when the composed computations start timers that are relative to--- each other because all computations may not be started at the same time and--- therefore timers in all of them may not start at the same time.  When--- relative timing among all computations is important or when we need to start--- all computations at once for any reason 'Parallel' style must be used--- instead.------- $parallel------ The 'Semigroup' operation '<>' of the 'Parallel' type combines the two--- streams in a fairly concurrent manner with round robin scheduling. We use--- the 'fromParallel' type combinator to effect 'Parallel' style of composition.--- We can also use the 'Parallel' type annotation for the stream type to--- achieve the same effect.------ When two streams with multiple elements are combined in this manner, the--- monadic actions in both the streams are performed concurrently with a fair--- round robin scheduling.  The outputs are yielded in the order in which the--- actions complete. This is pretty similar to the 'WAsync' type, the--- difference is that 'WAsync' is adaptive to the consumer demand and may or--- may not execute all actions in parallel depending on the demand, whereas--- 'Parallel' runs all the streams in parallel irrespective of the demand.------ The polymorphic version of the binary operation '<>' of the 'Parallel' type--- is 'parallel'. We can use 'parallel' to join streams in a fairly concurrent--- manner irrespective of the type, notice that we have not used the--- 'fromParallel' combinator in the following example:------ >>> Stream.drain $ delay 3 `Stream.parallel` delay 2 `Stream.wAsync` delay 1--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ Note that this style of composition cannot be used to combine infinite--- number of streams, as it will lead to an infinite sized scheduling queue.------- XXX to be removed--- $custom------ The 'mkAsync' API can be used to create references to asynchronously running--- stream computations. We can then use 'uncons' to explore the streams--- arbitrarily and then recompose individual elements to create a new stream.--- This way we can dynamically decide which stream to explore at any given--- time.  Take an example of a merge sort of two sorted streams. We need to--- keep consuming items from the stream which has the lowest item in the sort--- order.  This can be achieved using async references to streams. See--- "MergeSort.hs" in <https://github.com/composewell/streamly-examples Streamly Examples>.---- $monoid------ All of the following are equivalent and start ten concurrent tasks each with--- a delay from 1 to 10 seconds, resulting in the printing of each number every--- second:------ >>> :{--- main = do---  Stream.drain $ Stream.fromAsync $ foldMap delay [1..10]---  Stream.drain $ Stream.concatFoldableWith Stream.async (map delay [1..10])---  Stream.drain $ Stream.concatMapFoldableWith Stream.async delay [1..10]---  Stream.drain $ Stream.concatForFoldableWith Stream.async [1..10] delay--- :}------- $aheadNesting------ The 'Monad' composition of 'Ahead' type behaves just like 'Serial' except--- that it can speculatively perform a bounded number of next iterations of a--- loop concurrently.------ >>> :{--- Stream.toList $ Stream.fromAhead $ do---     x <- Stream.fromFoldable [3,2,1]---     delay x---     return x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- [3,2,1]------ This code finishes in 3 seconds, 'Serial' would take 6 seconds.  As we can--- see all the three iterations are concurrent and run in different threads,--- however, the results are returned in the serial order.------ Concurrency is demand driven, when multiple streams are composed using this--- style, the iterations are executed in a depth first manner just like--- 'Serial' i.e. nested iterations are executed before we proceed to the next--- outer iteration. The only difference is that we may execute multiple future--- iterations concurrently and keep the results ready.------ The 'fromAhead' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Ahead'.------- $concurrentNesting------ The 'Monad' composition of 'Async' type can perform the iterations of a--- loop concurrently.------ >>> :{--- Stream.drain $ Stream.fromAsync $ do---      x <- Stream.fromFoldable [3,2,1]---      delay x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ As we can see the code after the @fromFoldable@ statement is run three--- times, once for each value of @x@. All the three iterations are concurrent--- and run in different threads. The iteration with least delay finishes first.--- When compared to imperative programming, this can be viewed as a @for@ loop--- with three concurrent iterations.------ Concurrency is demand driven i.e. more concurrent iterations are started--- only if the previous iterations are not able to saturate the consumer of the--- output stream.  This works exactly the same way as the merging of two--- streams using 'async' works.------ The 'fromAsync' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Async'.------ When multiple streams are nested using this style, the iterations are--- concurrently evaluated in a depth first manner:--------- >>> :{--- Stream.drain $ Stream.fromAsync $ do---     x <- Stream.fromFoldable [1,2]---     y <- Stream.fromFoldable [3,4]---     Stream.fromEffect $ putStrLn $ show (x, y)--- :}--- (1,3)--- ...--- ...--- ...------ Nested iterations are given preference for concurrent evaluation i.e.--- (1,4) will be scheduled in preference to (2,3).---- $wasyncNesting------ Like 'Async', the 'Monad' composition of 'WAsync' runs the iterations of a--- loop concurrently. It differs from 'Async' in the nested loop behavior. Like--- 'WSerial', the nested loops in this type are traversed and executed in a--- breadth first manner rather than the depth first manner of 'Async' style.------ >>> :{--- Stream.drain $ Stream.fromWAsync $ do---     x <- Stream.fromSerial $ Stream.fromFoldable [1,2]---     y <- Stream.fromSerial $ Stream.fromFoldable [3,4]---     Stream.fromEffect $ putStrLn $ show (x, y)--- :}--- (1,3)--- (1,4)--- (2,3)--- (2,4)------ Note that (2,3) is preferred to (1,4) when evaluating the iterations--- concurrently.  This works exactly the same way as the merging of two streams--- using 'wAsync' works.------ The 'fromWAsync' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'WAsync'.------- $parallelNesting------ Just like 'Async' or 'WAsync' the 'Monad' composition of 'Parallel' runs the--- iterations of a loop concurrently.------ >>> :{--- Stream.drain $ Stream.fromParallel $ do---    x <- Stream.fromFoldable [3,2,1]---    delay x--- :}--- ThreadId ...: Delay 1--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3------ It differs from 'Async' and 'WAsync' in the nested loop behavior. All--- iterations of the loop are run fully concurrently irrespective of the--- demand.  This works exactly the same way as the merging of streams using--- 'parallel' works.------ The 'fromParallel' type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'Parallel'.------- $applicative------ 'Async' can run the iterations concurrently, therefore, it takes a total--- of 6 seconds which is max (1, 2) + max (3, 4):------ >>> (Stream.toList $ Stream.fromAsync $ (,) <$> s1 <*> s2) >>= print--- ...------ @--- ThreadId 34: Delay 1--- ThreadId 36: Delay 2--- ThreadId 35: Delay 3--- ThreadId 36: Delay 3--- ThreadId 35: Delay 4--- ThreadId 36: Delay 4--- [(1,3),(2,3),(1,4),(2,4)]--- @------ Similarly, 'WAsync' as well can run the iterations concurrently, but with a--- different style of scheduling than 'Async' as explained in the Monad--- section, therefore, it too takes a total of 6 seconds (2 + 4):------ >>> (Stream.toList $ Stream.fromWAsync $ (,) <$> s1 <*> s2) >>= print--- ...------ @--- ThreadId 34: Delay 1--- ThreadId 36: Delay 2--- ThreadId 35: Delay 3--- ThreadId 36: Delay 3--- ThreadId 35: Delay 4--- ThreadId 36: Delay 4--- [(1,3),(2,3),(1,4),(2,4)]--- @---- $parallelzip------ The applicative instance of 'ZipAsync' type zips streams concurrently.--- 'fromZipAsync' type combinator can be used to switch to parallel applicative--- zip composition:------ >>> d n = unCrossStream (CrossStream (delay n) >> return n)--- >>> s1 = Stream.fromSerial $ d 2 <> d 4--- >>> s2 = Stream.fromSerial $ d 3 <> d 1--- >>> (Stream.toList $ Stream.fromZipAsync $ (,) <$> s1 <*> s2) >>= print--- ThreadId ...: Delay 2--- ThreadId ...: Delay 3--- ThreadId ...: Delay 1--- ThreadId ...: Delay 4--- [(2,3),(4,1)]------ The actions within each stream are executed serially, however, the two--- streams are run concurrently with respect to each other. Therefore, it takes--- 6 seconds to zip the two streams, which is the maximum of the time to--- evaluate stream s1 (2 + 4 = 6 seconds) and stream s2 (3 + 1 = 4 seconds).---- $concurrent------ When writing concurrent programs there are two distinct places where the--- programmer can control the concurrency. First, when /composing/ a stream by--- merging multiple streams we can choose an appropriate sum style operators to--- combine them concurrently or serially. Second, when /processing/ a stream in--- a monadic composition we can choose one of the monad composition types to--- choose the desired type of concurrency.------ In the following example the squares of @x@ and @y@ are computed--- concurrently using the 'async' operation and the square roots of their--- sum are computed serially because of the 'fromSerial' combinator. We can--- choose different combinators for the monadic processing and the stream--- generation, to control the concurrency.  We can also use the 'fromAsync'--- combinator instead of explicitly folding with 'async'.------ >>> import Data.List (sum)--- >>> :{--- main = do---     z <- Stream.toList---          $ Stream.fromSerial     -- Serial monadic processing (sqrt below)---          $ unCrossStream $ do---              -- Concurrent @"for"@ loop---              x2 <- CrossStream (Stream.concatForFoldableWith Stream.async [1..100] $---                          \x -> Stream.fromPure $ x * x)  -- body of the loop---              y2 <- CrossStream (Stream.concatForFoldableWith Stream.async [1..100] $---                          \y -> Stream.fromPure $ y * y)---              return $ sqrt (x2 + y2)---     print $ sum z--- :}------ We can see how this directly maps to the imperative style--- <https://en.wikipedia.org/wiki/OpenMP OpenMP> model, we use combinators--- and operators instead of the ugly pragmas.------ For more concurrent programming examples see,--- <https://github.com/composewell/streamly-examples>.---- $furtherReading------ * Read the reactive programming tutorial--- * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
@@ -1,1 +0,0 @@-https://github.com/composewell/streamly-examples
− docs/User/Tutorials/ReactiveProgramming.hs 
@@ -1,126 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : User.Tutorials.ReactiveProgramming--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ THIS TUTORIAL IS OBSOLETE.------ In this tutorial we will show how Streamly can be used for reactive--- programming.  Before you go through this tutorial we recommend that you take--- a look at the Streamly concurrent programming tutorial.--module User.Tutorials.ReactiveProgramming-    (-    -- * Reactive Programming-    -- $reactive--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Data.Stream-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- $reactive------ Reactive programming is nothing but concurrent streaming which is what--- streamly is all about. With streamly we can generate streams of events,--- merge streams that are generated concurrently and process events--- concurrently. We can do all this without any knowledge about the specifics--- of the implementation of concurrency. In the following example you will see--- that the code is just regular Haskell code without much streamly APIs used--- (active hyperlinks are the streamly APIs) and yet it is a reactive--- application.------ This application has two independent and concurrent sources of event--- streams, @acidRain@ and @userAction@. @acidRain@ continuously generates--- events that deteriorate the health of the character in the game.--- @userAction@ can be "potion" or "quit". When the user types "potion" the--- health improves and the game continues.------ @--- {-\# LANGUAGE FlexibleContexts \#-}------ import "Streamly.Prelude" (MonadAsync, SerialT)--- import "Streamly.Prelude" as Stream--- import Control.Monad (void)--- import Control.Monad.IO.Class (MonadIO(liftIO))--- import Control.Monad.State (MonadState, get, modify, runStateT)------ data Event = Quit | Harm Int | Heal Int deriving (Show)------ userAction :: MonadAsync m => 'SerialT' m Event--- userAction = Stream.'repeatM' $ liftIO askUser---     where---     askUser = do---         command <- getLine---         case command of---             "potion" -> return (Heal 10)---             "harm"   -> return (Harm 10)---             "quit"   -> return Quit---             _        -> putStrLn "Type potion or harm or quit" >> askUser------ acidRain :: MonadAsync m => 'SerialT' m Event--- acidRain = Stream.'fromAsync' $ Stream.'constRate' 1 $ Stream.'repeatM' $ liftIO $ return $ Harm 1------ data Result = Check | Done------ runEvents :: (MonadAsync m, MonadState Int m) => 'SerialT' m Result--- runEvents = do---     event \<- userAction \`Stream.'parallel'` acidRain---     case event of---         Harm n -> modify (\\h -> h - n) >> return Check---         Heal n -> modify (\\h -> h + n) >> return Check---         Quit -> return Done------ data Status = Alive | GameOver deriving Eq------ getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status--- getStatus result =---     case result of---         Done  -> liftIO $ putStrLn "You quit!" >> return GameOver---         Check -> do---             h <- get---             liftIO $ if (h <= 0)---                      then putStrLn "You die!" >> return GameOver---                      else putStrLn ("Health = " <> show h) >> return Alive------ main :: IO ()--- main = do---     putStrLn "Your health is deteriorating due to acid rain, type \\\"potion\\\" or \\\"quit\\\""---     let runGame = Stream.'drainWhile' (== Alive) $ Stream.'mapM' getStatus runEvents---     void $ runStateT runGame 60--- @------ You can also find the source of this example in the streamly-examples repo--- as <https://github.com/composewell/streamly-examples/tree/master/AcidRain.hs AcidRain.hs>.--- It has been adapted from Gabriel's--- <https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html pipes-concurrency>--- package.--- This is much simpler compared to the pipes version because of the builtin--- concurrency in streamly. You can also find a SDL based reactive programming--- example adapted from Yampa in--- <https://github.com/composewell/streamly-examples/tree/master/CirclingSquare.hs CirclingSquare.hs>.---- $performance------ Streamly is highly optimized for performance, it is designed for serious--- high performing, concurrent and scalable applications. We have created the--- <https://hackage.haskell.org/package/streaming-benchmarks streaming-benchmarks>--- package which is specifically and carefully designed to measure the--- performance of Haskell streaming libraries fairly and squarely in the right--- way. Streamly performs at par or even better than most streaming libraries--- for serial operations even though it needs to deal with the concurrency--- capability.---- $furtherReading------ * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
− docs/User/Tutorials/Tutorial.hs 
@@ -1,521 +0,0 @@-{-# OPTIONS_GHC -fno-warn-unused-imports #-}--- |--- Module      : User.Tutorials.Tutorial--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com------ THIS TUTORIAL IS OBSOLETE.------ In this tutorial we will show how Streamly can be used for idiomatic--- dataflow programming.  Before you go through this tutorial we recommend that--- you take a look at the Streamly Getting Started guide so that you are ready--- to try out the examples.--module User.Tutorials.Tutorial-    (-    -- * Imports-    -- $setup--    -- * Stream Types-    -- $streams--    -- * Imports and Supporting Code-    -- $imports--    -- * Generating Streams-    -- $generating--    -- * Eliminating Streams-    -- $eliminating--    -- * Transforming Streams-    -- $transformation--    -- * Merging Streams--    -- ** Semigroup Style-    -- $semigroup--    -- *** Deep Serial Composition ('Serial')-    -- $serial--    -- *** Wide Serial Composition ('WSerial')-    -- $interleaved--    -- ** Monoid Style-    -- $monoid--    -- * Nesting Streams-    -- $nesting--    -- ** Monad-    -- $monad--    -- *** Deep Serial Nesting ('Serial')-    -- $regularSerial--    -- *** Wide Serial Nesting ('WSerial')-    -- $interleavedNesting--    -- *** Exercise-    -- $monadExercise--    -- ** Applicative-    -- $applicative--    -- ** Functor-    -- $functor--    -- * Zipping Streams-    -- $zipping--    -- ** Serial Zipping-    -- $serialzip--    -- * Where to go next?-    -- $furtherReading-    )-where--import Streamly.Data.Stream-import Data.Semigroup-import Control.Applicative-import Control.Monad-import Control.Monad.IO.Class      (MonadIO(..))-import Control.Monad.Trans.Class   (MonadTrans (lift))---- CAUTION: please keep setup and imports sections in sync---- XXX This tutorial has to be re-written.---- $setup------ In most of example snippets we do not repeat the imports. Where--- imports are not explicitly specified use the imports shown below.------ >>> :m--- >>> :set -fno-warn-deprecations--- >>> import Data.Function ((&))--- >>> import Streamly.Prelude ((|:), (|&))--- >>> import Streamly.Data.Stream (Stream)--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold------- $streams------ The monadic stream API offered by Streamly is very close to the Haskell--- "Prelude" pure lists' API, it can be considered as a natural extension of--- lists to monadic actions. Streamly streams provide concurrent composition--- and merging of streams. It can be considered as a concurrent list--- transformer.------ The 'Serial' type is almost a drop in replacement for pure lists,--- pure lists are a special case of monadic streams. If you use 'nil' in place--- of '[]' and '|:' in place ':' you can replace a list with a 'Serial' stream.--- The only difference is that the elements must be monadic type and to operate--- on the streams we must use the corresponding functions from--- "Streamly.Prelude" instead of using the base "Prelude".---- $generating------ 'nil' represents an empty stream and 'consM' or its operator form '|:' adds--- a monadic action at the head of the stream.------ >>> Stream.toList Stream.nil--- []------ Stream.toList $ getLine |: getLine |: Stream.nil--- hello--- world--- ["hello","world"]------ To create a singleton stream from a pure value use 'fromPure' and to--- create a singleton stream from a monadic action use 'fromEffect'.------ >>> Stream.toList $ Stream.fromPure 1--- [1]------ Stream.toList $ Stream.fromEffect getLine--- hello--- ["hello"]------ To create a stream from pure values in a 'Foldable' container use--- 'fromFoldable' which is equivalent to a fold using 'cons' and 'nil':------ >>> Stream.toList $ Stream.fromFoldable [1..3]--- [1,2,3]------ >>> Stream.toList $ Prelude.foldr Stream.cons Stream.nil [1..3]--- [1,2,3]------ To create a stream from monadic actions in a 'Foldable' container just use a--- right fold using 'consM' and 'nil':------ >>> Stream.drain $ Prelude.foldr (|:) Stream.nil [putStr "Hello ", putStrLn "world!"]--- Hello world!------ For more ways to construct a stream see the module "Streamly.Prelude".---- $eliminating------ We have already seen 'drain' and toList to eliminate a stream in the--- examples above.  'drain' runs a stream discarding the results i.e. only--- for effects.  'toList' runs the stream and collects the results in a list.------ For other ways to eliminate a stream see the @Folding@ section in--- "Streamly.Prelude" module.---- $transformation------ Transformation over a stream is the equivalent of a @for@ loop construct in--- imperative paradigm. We iterate over every element in the stream and perform--- certain transformations for each element.  Transformations may involve--- mapping functions over the elements, filtering elements from the stream or--- folding all the elements in the stream into a single value. Streamly streams--- are exactly like lists and you can perform all the transformations in the--- same way as you would on lists.------ Here is a simple console echo program that just echoes every input line,--- forever:------ >>> :{--- echo =---       Stream.repeatM getLine---     & Stream.mapM putStrLn---     & Stream.drain--- :}------ The following code snippet reads lines from standard input, filters blank--- lines, drops the first non-blank line, takes the next two, up cases them,--- numbers them and prints them:------ >>> import Data.Char (toUpper)--- >>> :{--- main =---       Stream.repeatM getLine---     & Stream.filter (not . null)---     & Stream.drop 1---     & Stream.take 2---     & fmap (map toUpper)---     & Stream.zipWith (\n s -> show n ++ " " ++ s) (Stream.fromFoldable [1..])---     & Stream.mapM putStrLn---     & Stream.drain--- :}------- $semigroup------ We can combine two streams into a single stream using semigroup composition--- operation '<>'.  Streams can be combined in many different ways as described--- in the following sections, the '<>' operation behaves differently depending--- on the stream type in effect. The stream type and therefore the composition--- style can be changed at any point using one of the type combinators as--- discussed earlier.---- $serial------ The 'Semigroup' operation '<>' of the 'Serial' type combines the two streams--- in a /serial depth first/ manner. We use the 'fromSerial' type combinator to--- effect 'Serial' style of composition. We can also use an explicit 'Serial'--- type annotation for the stream to achieve the same effect.  However, since--- 'Serial' is the default type unless explicitly specified by using a--- combinator, we can omit using an explicit combinator or type annotation for--- this style of composition.------ When two streams with multiple elements are combined in this manner, the--- monadic actions in the two streams are performed sequentially i.e. first all--- actions in the first stream are performed sequentially and then all actions--- in the second stream are performed sequentially. We call it--- /serial depth first/ as the full depth of one stream is fully traversed--- before we move to the next. The following example prints the sequence 1, 2,--- 3, 4:------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ stream1 <> stream2--- 1--- 2--- 3--- 4------ All actions in both the streams are performed serially in the same thread.------ The polymorphic version of the binary operation '<>' of the 'Serial' type is--- 'serial'. We can use 'serial' to join streams in a sequential manner--- irrespective of the type of stream:------ >>> Stream.drain $ stream1 `Stream.serial` stream2--- 1--- 2--- 3--- 4------- $interleaved------ The 'Semigroup' operation '<>' of the 'WSerial' type combines the two--- streams in a /serial breadth first/ manner. We use the fromWSerial type--- combinator to effect 'WSerial' style of composition. We can also use the--- 'WSerial' type annotation for the stream to achieve the same effect.------ When two streams with multiple elements are combined in this manner, we--- traverse all the streams in a breadth first manner i.e. one action from each--- stream is performed and yielded to the resulting stream before we come back--- to the first stream again and so on.--- The following example prints the sequence 1, 3, 2, 4------ >>> stream1 = print 1 |: print 2 |: Stream.nil--- >>> stream2 = print 3 |: print 4 |: Stream.nil--- >>> Stream.drain $ Stream.fromWSerial $ stream1 <> stream2--- 1--- 3--- 2--- 4------ Even though the monadic actions of the two streams are performed in an--- interleaved manner they are all performed serially in the same thread.------ The polymorphic version of the 'WSerial' binary operation '<>' is called--- 'wSerial'. We can use 'wSerial' to join streams in an interleaved manner--- irrespective of the type, notice that we have not used the fromWSerial--- combinator in the following example:------ >>> Stream.drain $ stream1 `Stream.wSerial` stream2--- 1--- 3--- 2--- 4------ Note that this composition cannot be used to fold infinite number of streams--- since it requires preserving the state until a stream is finished.---- $monoid------ We can use 'Monoid' instances to fold a container of streams in the desired--- style using 'fold' or 'foldMap'.  We have also provided some fold utilities--- to fold streams using the polymorphic combine operations:------ * 'concatFoldableWith' is like 'fold', it folds a 'Foldable' container of--- streams using the given composition operator.--- * 'concatMapFoldableWith' is like 'foldMap', it folds like--- @concatFoldableWith@ but also maps a function before folding.--- * 'concatForFoldableWith' is like @concatMapFoldableWith@ but the container--- argument comes before the function argument.------ All of the following are equivalent:------ >>> :{--- traced = Stream.fromEffect . print--- main = do---  Stream.drain $ foldMap traced [1..10]---  Stream.drain $ Stream.concatFoldableWith Stream.serial (map traced [1..10])---  Stream.drain $ Stream.concatMapFoldableWith Stream.serial traced [1..10]---  Stream.drain $ Stream.concatForFoldableWith Stream.serial [1..10] traced--- :}------- $nesting------ Till now we discussed ways to apply transformations on a stream or to merge--- streams together to create another stream. We mentioned earlier that--- transforming a stream is similar to a @for@ loop in the imperative paradigm.--- We will now discuss the concept of a nested composition of streams which is--- analogous to nested @for@ loops in the imperative paradigm. Functional--- programmers call this style of composition a list transformer or @ListT@.--- Logic programmers call it a logic monad or non-deterministic composition,--- but for ordinary imperative minded people like me it is easier to think in--- terms of good old nested @for@ loops.------ $monad------ In functional programmer's parlance the 'Monad' instances of different--- 'IsStream' types implement non-determinism, exploring all possible--- combination of choices from both the streams. From an imperative--- programmer's point of view it behaves like nested loops i.e.  for each--- element in the first stream and for each element in the second stream--- execute the body of the loop.------ The 'Monad' instances of 'Serial', 'WSerial', 'Async' and 'WAsync'--- stream types support different flavors of nested looping.  In other words,--- they are all variants of list transformer.  The nesting behavior of these--- types correspond exactly to the way they merge streams as we discussed in--- the previous section.------- $regularSerial------ The 'Monad' composition of the 'CrossStream' type behaves like a standard list--- transformer.------ Let's start with an example with a simple @for@ loop without any nesting.--- For simplicity of illustration we are using streams of pure values in all--- the examples.  However, the streams could also be made of monadic actions--- instead.------ >>> :{--- Stream.drain $ unCrossStream $ do---     x <- CrossStream (Stream.fromFoldable [3,2,1])---     CrossStream (Stream.fromEffect $ print x)--- :}--- 3--- 2--- 1------ As we can see, the code after the @fromFoldable@ statement is run three--- times, once for each value of @x@ drawn from the stream. All the three--- iterations are serial and run in the same thread one after another. In--- imperative terms this is equivalent to a @for@ loop with three iterations.------ We can write the console echo program that we wrote earlier using the monad--- instance:------ >>> :{--- main =---     Stream.drain $ unCrossStream $ do---         x <- CrossStream (Stream.repeatM getLine)---         CrossStream (Stream.fromEffect $ putStrLn x)--- :}------ When multiple streams are composed using this style they nest in a DFS--- manner:------ >>> :{--- Stream.drain $ unCrossStream $ do---   x <- CrossStream (Stream.fromFoldable [1,2])---   y <- CrossStream (Stream.fromFoldable [3,4])---   CrossStream (Stream.fromEffect $ print (x, y))--- :}--- (1,3)--- (1,4)--- (2,3)--- (2,4)------ i.e. inner loop iterations ((1,3), (1,4)) are executed before we proceed to--- the next iteration of the outer loop ((2,3), (2,4)). This behaves just like--- nested @for@ loops in imperative programming.------ Notice that this is analogous to merging streams of type 'Serial' or merging--- streams using 'serial'.---- $interleavedNesting------ TBD: generate the WSerial type using the TH utils.------ The 'Monad' composition of 'WSerial' type interleaves the iterations of--- outer and inner loops in a nested loop composition.------ >> :{--- Stream.drain $ getWSerial $ do---      x <- WSerialStream (Stream.fromFoldable [1,2])---      y <- WSerialStream (Stream.fromFoldable [3,4])---      WSerialStream (Stream.fromEffect $ print (x, y))--- :}--- (1,3)--- (2,3)--- (1,4)--- (2,4)------ Note that (2,3) is preferred to (1,4).  This works exactly the same way as--- the merging of two streams using 'wSerial' works.------ The fromWSerial type combinator can be used to switch to this style of--- composition. Alternatively, a type annotation can be used to specify the--- type of the stream as 'WSerial'.------- $monadExercise------ >>> :{--- composed :: Stream IO ()--- composed = unCrossStream $ do---     sz <- CrossStream sizes---     cl <- CrossStream colors---     sh <- CrossStream shapes---     CrossStream (Stream.fromEffect $ print (sz, cl, sh))---     where---     sizes  = Stream.fromFoldable [1, 2, 3]---     colors = Stream.fromFoldable ["red", "green", "blue"]---     shapes = Stream.fromFoldable ["triangle", "square", "circle"]--- :}------- $functor------ 'fmap' transforms a stream by mapping a function on all elements of the--- stream. 'fmap' behaves in the same way for all stream types, it is always--- serial.------ >>> (Stream.toList $ fmap show $ Stream.fromFoldable [1..10]) >>= print--- ["1","2","3","4","5","6","7","8","9","10"]------ Also see functions 'mapM' and 'sequence' from "Streamly.Prelude" module--- which can map actions concurrently depending on the type of the input stream.---- $applicative------ Applicative is precisely the same as the 'ap' operation of 'Monad'. For--- zipping applicatives separate types 'ZipStream' and 'ZipAsync' are--- provided.------ The following is an example of 'CrossStream' applicative, it runs all iterations--- serially:------ >>> p n = Stream.fromEffect (print n >> pure n)--- >>> s1 = p 1 <> p 2--- >>> s2 = p 3 <> p 4------ >>> (Stream.toList $ unCrossStream $ (,) <$> CrossStream s1 <*> CrossStream s2) >>= print--- 1--- 3--- 4--- 2--- 3--- 4--- [(1,3),(1,4),(2,3),(2,4)]------ Similarly, 'WSerial' applicative runs the iterations in an interleaved--- order but being serial it too takes a total of 17 seconds:------ >> (Stream.toList $ Stream.WSerialStream $ (,) <$> WSerialStream s1 <*> WSerialStream s2) >>= print--- 1--- 3--- 2--- 3--- 4--- 4--- [(1,3),(2,3),(1,4),(2,4)]---- $zipping------ Zipping is a special transformation where the corresponding elements of two--- streams are combined together using a zip function producing a new stream of--- outputs. Two different types are provided for serial and concurrent zipping.--- These types provide an applicative instance that can be used to lift--- functions to zip the argument streams.--- Also see the zipping functions in the "Streamly.Prelude" module.---- $serialzip------ The applicative instance of 'ZipSerial' type zips streams serially.--- 'fromZipSerial' type combinator can be used to switch to serial applicative--- zip composition:------ >>> p n = Stream.fromEffect (print n >> pure n)--- >>> s1 = Stream.fromSerial $ p 1 <> p 2--- >>> s2 = Stream.fromSerial $ p 3 <> p 4--- >>> (Stream.toList $ Stream.fromZipSerial $ (,) <$> s1 <*> s2) >>= print--- 1--- 3--- 2--- 4--- [(1,3),(2,4)]------- $furtherReading------ * Read the concurrent streams tutorial--- * See the examples in <https://github.com/composewell/streamly-examples streamly-examples> repo.
+ docs/User/Tutorials/all-your-base.jpg view

binary file changed (absent → 147629 bytes)

− docs/User/Tutorials/before-you-begin.md 
@@ -1,77 +0,0 @@-<!---(c) 2022, Composewell Technologies.-SPDX-License-Identifer: BSD-3-Clause--->--# Before You Begin--In this tutorial, we assume basic knowledge of Haskell syntax, constructs and-lazy evaluation. The [Haskell wikibook](https://en.wikibooks.org/wiki/Haskell)-may be a good place to start and get familiar with Haskell.--## Installing Haskell--If you wish to follow along and run the examples in this tutorial, you will-need to have Haskell tool chain installed.--You can choose one of the following sections.--### Haskell Toolchain--To get started, you will need a fairly recent version (last three major-versions will work) of the Haskell compiler `ghc` and the build tool-`cabal` installed on your system.  Please see the install instructions-at https://www.haskell.org/downloads/ .--### Development Environment using Nix--If you use the nix package manager, a nix shell for complete-development environment - including a consistent set of latest streamly-ecosystem packages, hoogle documentation, vim and vscode editors,-Haskell language server (HLS) and other tools - is available at-[streamly-packages][streamly-packages].--## Building for Performance--If you wish to run benchmarks, please be sure to build your-application using the instructions in the [Build Guide](/docs/User/HowTo/Compiling.md).--## Streamly Library Packages--Streamly comprises two packages, the-[streamly-core](https://hackage.haskell.org/package/streamly-core)-package provides functionality that depends only on boot libraries, and-the [streamly](https://hackage.haskell.org/package/streamly) package-provides additional functionality like concurrency, time, lifted-exceptions, and networking.--For high-level functionality built over streamly like streaming-system processes, shell programming, GNU coreutils, statistics,-and compression libraries please see the [streamly ecosystem-packages](https://streamly.composewell.com/ecosystem.html).--## Released and Pre-release modules--Some of the examples in this tutorial may use modules from the-`Internal` Streamly module hierarchy.  These modules are not really-internal to the library.  We classify `Streamly` modules into two-categories:--* _Released modules and APIs_: These modules and APIs are-  stable. Significant changes to these modules and APIs will cause-  Streamly's version number to change according to the package versioning-  policy.-* _Pre-release modules and APIs_: These modules and APIs have not been-  formally released yet.  They may change in the near future, and such-  changes will not necessarily be reflected in Streamly's package-  version number.  As yet unreleased modules and APIs reside in the-  `Internal` namespace.--Please use a minor release upper bound to adhere to the Haskell PVP when-using a pre-release (internal) module.--<!---Link References.--->--[Streamly]: https://streamly.composewell.com/
@@ -0,0 +1,1 @@+https://github.com/composewell/streamly-examples/blob/master/README.md
+ docs/User/Tutorials/functionality-overview.md view
@@ -0,0 +1,135 @@+# Functionality At a Glance++Streamly allows the programmer to write high-performance code+concisely and idiomatically using high level constructs, and with high+expressivity.++## Streams++**Streaming**: Streamly is a general purpose computing framework+based on data flow programming paradigm also known as the streaming+paradigm.  Streaming enables writing modular and composable applications+declaratively.++**High Performance**: Streamly focuses on high performance in all+areas comparable to low programming languages like C. To achieve that+streamly uses a GHC optimization popularly known as stream fusion. All+abstractions in streamly are designed for stream fusion. It makes sure+that stream fusion works reliably. The abstractions in streamly also+allow nested stream fusion, for example, the `Unfold` abstraction is+specifically designed for nested fusion (an alternative to `concatMap`)+which does not fuse.++**Unified Abstractions**: Furthermore, streamly provides a range+of unified streaming abstractions for representing real life+applications. In general, it includes stream producers and consumers. In+particular, streaming abstractions include `Stream` representing the+stream producers, `Scan` the stream transformers, `Fold` representing+the stream consumers, `Parser` representing the stream consumers with+failure and backtracking. All these abstractions are unified, interwork+with each other, they are all designed based on the same underlying+principles. All other functionality in streamly and applications based+on streamly are designed based on these fundamental abstractions.++**Concise**: The functionality of lists, list-transformer,+logic-programming, streaming, streaming folds, parsers which is covered+by numerous library in the Haskell ecosystem are all represented+efficiently, with the highest possible performance with just these few+abstractions.++**Interworking**: Streamly streams can be converted to and from other streaming+types in the Haskell ecosystem. See the [interop+examples](https://github.com/composewell/streamly-examples/tree/master/examples/Interop)+in the [streamly-examples](https://github.com/composewell/streamly-examples)+repository.++## Arrays++**Arrays**: Arrays complement streams. While streams are used for+in-flight data processing, arrays are used for storing data-at-rest+and for random access. If you look carefully, the core functionality+in streamly is _only_ streams and arrays, the remaining part is just+high level functionality built on these two. All you need to build+any application is streams and arrays. Streamly unifies these two+fundamental concepts, they are intertwined, some stream functionality+requires arrays and some array functionality requires streams. That is+also the reason why we cannot separate these two cleanly in different+packages.++**High Performance**: Similar to streams, arrays are designed for high+performance. While arrays also provide native and high-performance+operations utilizing the random and chunked access nature of arrays,+in most cases they can be processed and transformed efficiently using+streams. Thus, providing a concise API utilizing streams. Unboxed arrays+provide the highest performance.++**Unified Abstractions**: Streamly provides a wide range of abstractions+using arrays to express all types of applications. Unboxed arrays+provide the highest performance whereas boxed arrays provide more+flexibility. Immutable arrays (the `Array` type) guarantee that the data+does not change whereas mutable arrays (the `MutArray` type) provide+in-place mutation for performance where needed. Pinned arrays provide+interfacing with the OS whereas unpinned arrays provide freedom from+fragmentation of memory. The `Unbox` and `Serialize` type classes assist+in high-performance serialization of Haskell data to and from arrays.++**Concise**: The functionality of array processing and serialization+which is covered by numerous library in the Haskell ecosystem are all+represented efficiently, well-integrated with streams, with the highest+possible performance, and in a concise and unified way. Especially, the+functionality of `bytestring`, `text` and `vector` packages can all be+represented by the single `Array` type in streamly and `MutArray` if you+want them to be mutable.++**Interworking**: Streamly arrays can be converted to and from+other popular array types (e.g. bytestring, text and vector) in+the Haskell ecosystem at zero cost i.e. without copying. See the+[streamly-bytestring](https://github.com/psibi/streamly-bytestring)+repository.+<!-- TODO add streamly-text and streamly-vector repos -->++## Declarative Concurrency++Streamly introduces concurrency to the streaming paradigm preserving+the modularity and composability of serial composition. It enables the+programmer to write concurrent programs in a high-level declarative+manner, without using low level concurrency primitives like threads+and synchronization. No explicit thread pools are needed. The degree+of concurrency can be automatically adjusted dynamically based on the+demand by the consumer.++Arrays are processed using streams and streams are concurrent,+therefore, arrays can be processed concurrently.++## Reactive Programming++Streaming and concurrency together enable expressing reactive+applications conveniently.  See the `AcidRain` game in [Streamly+Examples](https://github.com/composewell/streamly-examples) for a simple+reactive programming example.  See the `CirclingSquare` example in+[Streamly Examples](https://github.com/composewell/streamly-examples)+for a simple SDL based reactive programming example. To summarize,+streamly provides a unified computing framework for streaming,+non-determinism and functional reactive programming in an elegant and+simple API that is a natural extension of pure lists to monadic streams.++<!--+## Why data flow programming?++If you need some convincing for using streaming or data flow programming+paradigm itself then try to answer this question - why do we use lists in+Haskell? It boils down to why we use functional programming in the first place.+Haskell is successful in enforcing the functional data flow paradigm for pure+computations using lists, but not for monadic computations. In the absence of a+standard and easy to use data flow programming paradigm for monadic+computations, and the IO monad providing an escape hatch to an imperative+model, we just love to fall into the imperative trap, and start asking the same+fundamental question again - why do we have to use the streaming data model?+-->++## Batteries Included++As we discussed above the core abstractions in streamly are streams+and arrays. For basic programming needs we also need console IO, file+IO, network IO and unicode text processing. All this functionality is+provided by streamly using the core streaming and array abstractions.
− docs/User/Tutorials/getting-started.md 
@@ -1,225 +0,0 @@-<!---(c) 2019, Composewell Technologies.-Portions (c) 2020, Google LLC.-SPDX-License-Identifer: BSD-3-Clause--->--# Getting started with `Haskell Streamly`--This guide shows you how to use Streamly in `ghci` REPL, a simple-program or a Haskell project.--<!-- TODO: Add instructions for `stack` and `nix`.--If you are using `stack` or `nix` please make sure to add the latest-version from Hackage to your tool configuration.  -->--No prior knowledge of Haskell is needed.  We do however assume that you-are using a command-line shell on a POSIX operating system.  If you are-running Windows&trade; then you may need to run a command-line shell-under `msys` and some of the commands below may also need to be changed-in small ways to make them work.--## Using `streamly` Interactively in REPL--You can try out `streamly` using `GHCi`, the interactive Haskell-read-eval-print-loop (REPL).--Streamly consists of two packages, namely `streamly-core` and-`streamly`. The former package provides basic functionality and the-latter provides higher level functionality. To start up the GHCi REPL-using the latest released `streamly-core` package from Hackage, please-use:--```-$ cabal repl --build-depends streamly-core-... plenty of build messages, the first time around ...-GHCi, version 9.2.2: https://www.haskell.org/ghc/  :? for help-ghci>-```--This command may take a while to build the package first time around,-please be patient.--Once at the `ghci>` prompt, you can import Haskell modules from the-`streamly-core` package and use the available functions in the REPL:--```-ghci> import qualified Streamly.Data.Stream as Stream-ghci> import qualified Streamly.Data.Fold as Fold--ghci> Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]-1-2-3-ghci>-```--For the curious, here is a high level overview of what these lines-do:--1. `import qualified Streamly.Data.Stream as Stream` imports the Streamly-   Stream module into GHCi, and makes it available under the name `Stream`.-2. `[1..3]` generates the Haskell list `[1, 2, 3]`.-3. `Stream.fromList` transforms that list into a stream of integers.-4. `Stream.mapM print` transforms the stream of integers into a stream of-   actions that would print those integers when executed.-5. `Stream.fold Fold.drain` folds that stream using the `drain` fold,-   transforming it into an IO action that evaluates the stream.--### Using a specific version of `streamly` in the REPL--You can also ask `cabal` to use a specific version of `streamly-core` by-adding a version number constraint to the `--build-depends` flag:--```-$ cabal repl --build-depends streamly-core==0.1.0-...-ghci>-```--## Using `streamly` in a Project--Create a project directory for our example project.--```-$ mkdir streamly-project-```--### Add `streamly` as project dependency--Run `cabal init` in the project directory to create an initial set of-project files:--```-$ cd streamly-project-$ cabal init --non-interactive --minimal --dependency base --dependency streamly-core--...-Generating app/Main.hs...-Generating streamly-project.cabal...-...-```--This invocation sets up a Haskell package named `streamly-project`-with two build dependencies, namely `base` (the Haskell standard-library) and `streamly-core`.  You can add additional dependencies-later, by editing the `build-depends` section of the generated-cabal file `streamly-project.cabal`.  Please see the [Cabal User-Guide](https://www.haskell.org/cabal/users-guide/) for more information-on `.cabal` files.--IMPORTANT: Because of a bug in cabal 3.8, which is fixed in cabal 3.10,-this does not generate a dependency on `base`, please edit the generated-cabal file and add `base` in the `build-depends` section:--```-    build-depends: base, streamly-core-```--This invocation also creates a skeletal `app/Main.hs`, therefore, we can-compile and run it right away:--```-$ cabal run-Hello, Haskell!-```--### Import `streamly` modules in the project code--Let us now turn the single-line stanza we used in the REPL into a-standalone program.--Edit `app/Main.hs` to contain the following:--```haskell-module Main where--import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Data.Fold as Fold--main :: IO ()-main = Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]-```--Build and run this program using `cabal run`:--```-$ cabal run-... build messages ...-1-2-3-```--### Running GHCi REPL for the project code--To start up the GHCi REPL for your project, please use:--```-$ cabal repl-...-Ok, one module loaded.-ghci> main-1-2-3-ghci>-```--The repl will load all the dependencies and modules of the project. You can now-run your project code or any other code snippets as you desire.--### (Advanced) Using the development version of `streamly`--To use the development version of `streamly`, we need to configure-`cabal` to fetch it from Github.--Create a `cabal.project` file in the project directory with the-following content:--```-packages: .--- fetch streamly-core dependency package from github-source-repository-package-  type: git-  location: https://github.com/composewell/streamly-  subdir: core-  tag: master-```--With this file present, `cabal` will fetch and build the current-version of `streamly-core` from Github.  For example:--```-$ cabal repl-Cloning into '/home/harendra/streamly-project/...-...-In order, the following will be built (use -v for more details):- - streamly-core-0.1.0 (lib:streamly-core) (requires build)- - streamly-project-0.1.0.0 (exe:streamly-project) (configuration changed)- ...-ghci>-```--## Which version of `streamly` should you use?--If you are new to Streamly, we recommend using the latest [stable release-of streamly][streamly-hackage] on Hackage.--If you need access to cutting edge features (and do not mind the-occasional breakage), please use the [development version of-streamly][streamly-github] from Github.--## Next Steps--If you got this far successfully, congratulations!  For an overview-of the `streamly` package, please read the [Streamly Quick-Overview](/docs/User/Tutorials/quick-overview.md).--<!-- Markdown Links -->-- [Streamly]: https://streamly.composewell.com/- [streamly-hackage]: https://hackage.haskell.org/package/streamly- [streamly-github]: https://github.com/composewell/streamly- [streamly-packages]: https://github.com/composewell/streamly-packages
− docs/User/Tutorials/haskell-lazy-evaluation.md 
@@ -1,215 +0,0 @@-<!---(c) 2022, Composewell Technologies.-SPDX-License-Identifer: BSD-3-Clause--->--# Haskell Lazy Evaluation--Haskell is fundamentally different from other languages. In most-languages, a variable name refers to some concrete data in memory;  in-Haskell, a variable may refer to concrete data or it could refer to-a computation or expression which when evaluated would produce the-concrete data that the variable is referring to. When the value of the-variable is needed, the computation is evaluated and replaced by-the result.--When a Haskell program starts, the entire program is an unevaluated-expression which is evaluated on-demand as needed. The top level-expression is forced to produce data when a result is demanded from it-for IO.  Parts of the expression are reduced as needed, the reduction-process can be controlled by the programmer.--## Unevaluated Expressions--When we assign a value to a name, the name refers to the unevaluated-expression and not what it would produce when evaluated. For example:--```->>> infiniteList = [1..]-```--The name `infiniteList` refers to an expression which when evaluated-would generate the list. `infiniteList` is not an actual physical list-but just an expression to generate the list `when needed`. Because we-are not storing the actual list in memory, we can represent an infinite-list without requiring infinite amount of memory.--Let's try to get the length of this list:--```->>> len = length infiniteList-```--Like before, the name `len` refers to an expression that when evaluated-would give us the length of the list.  Till now Haskell has been saying-that I duly noted how to do what you want to do but I will do it only-when you need it. Let's ask it to do that now:--```->>> len-...hangs forever-```--Now, Haskell has no choice but to start evaluating the expression but we-know it can never finish because the list is infinite.--All expressions in Haskell are unevaluated by default.  Haskell-evaluates the expressions only when it is absolutely required e.g. when-we have to print something, or write it to a file or to network.--## On-demand Expression Evaluation--Let us illustrate expression evaluation in Haskell with an example. Write-this little program in a file `example.hs`:--```haskell-main =-    let largeList = [1..1000000::Int]-        n = length largeList-     in print n-```--The expression `largeList` is never evaluated to generate the entire-list at once. It is evaluated on-demand one element at a time by the-`length` function. The `length` function is in turn evaluated by the-`print` function when it evaluates its argument `n`. The `print`-function is evaluated by the top level program because it wants to print-`n` to the console.--We can verify that the whole list is not stored in memory by looking at-the memory usage of this program. Let's compile and run it:--```-$ ghc -O example.hs-$ ./example +RTS -s-1000000-          51,480 bytes allocated in the heap-              24 bytes copied during GC-          44,328 bytes maximum residency (1 sample(s))-```--`largeList` is an expression representing a million element list, but-the program takes only 44K maximum memory.  The `length` function-evaluates `largeList` one element at a time to count them, as soon as-an element is counted it can be garbage collected as there are no more-references to it in the entire program.--## Expressions Holding up Heap Memory--Let's try this program instead:--```haskell-main = do-    let largeList = [1..1000000::Int]-        x1 = last largeList-        x2 = head largeList-     in print (x1, x2)-```--```-$ ghc -O example.hs-$ ./example +RTS -s-(1000000,1)-      64,051,552 bytes allocated in the heap-             400 bytes copied during GC-      26,233,360 bytes maximum residency (4 sample(s))-```--This program is showing 26MB maximum residency instead of 44K-earlier. Why is it so? To evaluate the first element of the tuple, `x1`,-we need to evaluate the entire list to get to the last element. However,-the head of the list is referenced by the element `x2` as well which-is yet to be evaluated and used. Therefore, we need to retain the head-until `x2` is printed and freed. But head of the list is referencing the-next element in the list which in turn is referring to the next element-and so on, therefore, the entire list is retained in memory between the-evaluation of `x1` and `x2`.--If we change the print statement to `(x2, x1)` then we do not need to-retain the entire list between the two evaluations.--When memory is unexpectedly retained in a program it is known as a-"space-leak" in the Haskell parlance.--## Forcing Expression Evaluation--Even if there is no explicit dependency in the program forcing-evaluation of an expression, the programmer can force the evaluation of-an expression using `seq`:--```haskell-main = do-    let largeList = [1..1000000::Int]-        x1 = last largeList-        x2 = head largeList-     in print (x1 `seq` x2)-```--Similar to the example in previous section, this example also retains-the entire list in memory because `seq` forces `x1` to be evaluated-before `x2` and then returns `x2`, the evaluated list is held until `x2` is-returned.--## Avoiding Unnecessary Memory Retention--Memory retention can be avoided by changing the way we construct the-expression to process the data. We can use Streamly to avoid memory-retention in the above program.--Let's first write it using streamly and reproduce the same problem:--```haskell-import Data.Functor.Identity (runIdentity)-import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Data.Fold as Fold--main = do-    let largeList = Stream.fromList [1..1000000::Int]-        x1 = runIdentity $ Stream.fold Fold.latest largeList-        x2 = runIdentity $ Stream.fold Fold.one largeList-     in print (x1, x2)-```--This program has the same behavior as the list based program, and for-the same reasons.--```-$ ghc -O2 example.hs-$ ./example +RTS -s-(Just 1000000,Just 1)-      64,052,520 bytes allocated in the heap-             400 bytes copied during GC-      26,233,360 bytes maximum residency (4 sample(s))-```--However, we can compose the two folds using the `teeWith` combinator-such that we distribute a each element of the list to both the folds-simultaneously, thus avoiding the retainment of the entire list:--```haskell-import Data.Functor.Identity (runIdentity)-import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Data.Fold as Fold--main = do-    let largeList = Stream.fromList [1..1000000::Int]-        x = Fold.teeWith (,) Fold.latest Fold.one-     in print $ runIdentity $ Stream.fold x largeList-```--```-$ ghc -O2 example.hs-$ ./example +RTS -s-(Just 1000000,Just 1)-      64,052,736 bytes allocated in the heap-             280 bytes copied during GC-          44,328 bytes maximum residency (2 sample(s))-```--This program uses constant small memory footprint (44K) irrespective of-the order of the elements in the tuple. When an element is generated by-the list it is supplied to both the folds before generating the next-element, therefore, it can be immediately freed.--Streamly covers all the functionality of standard Haskell lists but in addition-provides powerful composition tools for better efficiency.
+ docs/User/Tutorials/installing-haskell.md view
@@ -0,0 +1,30 @@+<!--+(c) 2022, Composewell Technologies.+SPDX-License-Identifer: BSD-3-Clause+-->++# Installing Haskell++In this tutorial, we assume basic knowledge of Haskell syntax, constructs and+lazy evaluation. The [Haskell wikibook](https://en.wikibooks.org/wiki/Haskell)+may be a good place to start and get familiar with Haskell.++If you wish to follow along and run the examples in this tutorial, you will+need to have Haskell tool chain installed.++You can choose one of the following options.++## Haskell Toolchain++To get started, you will need a fairly recent version (latest three major+versions will work) of the Haskell compiler `ghc` and the build tool+`cabal` installed on your system.  Please see the install instructions+at https://www.haskell.org/downloads/ .++## Development Environment using Nix++If you use the nix package manager, a nix shell for complete Haskell+development environment - including a consistent set of latest streamly+ecosystem packages, hoogle documentation, vim and vscode editors,+Haskell language server (HLS) and other tools - is available at+[streamly-packages](https://github.com/composewell/streamly-packages).
+ docs/User/Tutorials/learn-by-examples.md view
@@ -0,0 +1,741 @@+<!--+(c) 2017, Composewell Technologies and Contributors+SPDX-License-Identifer: BSD-3-Clause+-->++# [Streamly][] Quick Tutorial+## About This Document++This guide introduces programming with [Streamly][] using a few practical+examples:++*  We will start with a simple program that [counts the number of words+   in a text](#modular-word-counting). We will then transform this program+   into a [concurrent](#concurrent-word-counting) program that can efficiently+   use multiprocessing hardware.+*  Next, we will create a [concurrent network+   server](#a-concurrent-network-server). We then show+   how to write a network server that [merges multiple+   streams](#merging-incoming-streams) concurrently.+*  Our third example shows how to list a directory tree concurrently,+   by reading [multiple directories in+   parallel](#listing-directories-recursivelyconcurrently).+*  Finally, we will look at how to [rate limit](#rate-limiting) stream+   processing.++It [concludes](#further-reading) with suggestions for further reading.++## Getting Started++### Installing Streamly++If you wish to follow along and run examples in this guide, please see+the [Using Streamly](/docs/User/Tutorials/using-streamly.md) guide+for instructions on how to use the `streamly` package interactively or+in a project.++Additionally, see [Installing+Haskell](/docs/User/Tutorials/installing-haskell.md) for instructions on how to+install haskell.++### An overview of the types used in these examples++As an expository device, we have indicated the types at the intermediate+stages of stream computations as comments in the examples below.+The meaning of these types are:++* A `Stream IO a` is a representation of a sequence of values of type+  `a` in the IO Monad.+* A `Fold IO a b` is a representation of a function that converts a stream of+  type `a` to a final accumulator of type `b` in the IO Monad.++## The Examples++The code snippets below should work in GHCi if all of those are typed+in sequence.  For brevity, imports that are already used in earlier+snippets are omitted from the latter ones.++### Modular Word Counting++A `Fold` in Streamly is a composable stream consumer.  For our first+example, we will use `Fold`s to count the number of bytes, words and lines+present in a file.  We will then compose individual `Fold`s together to+count words, bytes and lines at the same time.++Please see the file [WordCountModular.hs][] for the complete example+program.++#### Count Bytes (wc -c)++We start with a code fragment that counts the number of bytes in a file:++```haskell docspec+>>> import Data.Function ((&))+>>> import Streamly.FileSystem.Path (Path)+>>> import qualified Streamly.FileSystem.Path as Path+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.FileSystem.FileIO as File++>>> :{+wcb :: Path -> IO Int+wcb file = do+  File.read file               -- Stream IO Word8+    & Stream.fold Fold.length  -- IO Int+:}+```++### Count Lines (wc -l)++The next code fragment shows how to count the number of lines in a file:++```haskell docspec+>>> import Data.Word (Word8)+>>> import Streamly.Data.Fold (Fold)+>>> :{+-- ASCII character 10 is a newline.+countl :: Int -> Word8 -> Int+countl n ch = if ch == 10 then n + 1 else n+:}+>>> :{+-- The `nlines` fold accepts a stream of `Word8` and returns a line count (`Int`).+nlines :: Monad m => Fold m Word8 Int+nlines = Fold.foldl' countl 0+:}+>>> :{+wcl :: Path -> IO Int+wcl file =+    File.read file     -- Stream IO Word8+  & Stream.fold nlines -- IO Int+:}+```++### Count Words (wc -w)++Our final code fragment counts the number of whitespace-separated words+in a stream:++```haskell docspec+>>> import Data.Char (chr, isSpace)+>>> :{+countw :: (Int, Bool) -> Word8 -> (Int, Bool)+countw (n, wasSpace) ch =+    if isSpace $ chr $ fromIntegral ch+    then (n, True)+    else (if wasSpace then n + 1 else n, False)+:}+>>> :{+-- The `nwords` fold accepts a stream of `Word8` and returns a word count (`Int`).+nwords :: Monad m => Fold m Word8 Int+nwords = fst <$> Fold.foldl' countw (0, True)+:}+>>> :{+wcw :: Path -> IO Int+wcw file =+    File.read file      -- Stream IO Word8+  & Stream.fold nwords  -- IO Int+:}+```++### Counting Bytes, Words and Lines Together++By using the `Tee` combinator we can compose the three folds that count+bytes, lines and words individually into a single fold that counts all+three at once.  The applicative instance of `Tee` distributes its input+to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and+then combines the outputs from the folds using the supplied combiner+function (`(,,)`).++```haskell docspec+>>> import Streamly.Data.Fold (Tee(..))+>>> :{+-- The fold accepts a stream of `Word8` and returns the three counts.+countAll :: Fold IO Word8 (Int, Int, Int)+countAll = unTee $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords+:}+>>> :{+wc :: Path -> IO (Int, Int, Int)+wc file =+    File.read file       -- Stream IO Word8+  & Stream.fold countAll -- IO (Int, Int, Int)+:}+```++This example demonstrates the excellent modularity offered by+[Streamly][]'s simple and concise API.++### The Performance of Word Counting++We compare two equivalent implementations: one using [Streamly][],+and the other using C.++The performance of the [Streamly word counting+implementation][WordCount.hs] (using ghc-9.4.4 and fusion-plugin) is:++```+$ time WordCount-hs gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m2.033s+user    0m1.821s+sys     0m0.209s+```++The performance of an equivalent [wc implementation in C][WordCount.c] is:++```+$ time WordCount-c gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m2.113s+user    0m1.928s+sys     0m0.185s+```++### Concurrent Word Counting++In our next example we show how the task of counting words, lines,+and bytes could be done in parallel on multiprocessor hardware.++To count words in parallel we first divide the stream into chunks+(arrays), do the counting within each chunk, and then add all the+counts across chunks.  We use the same code as above except that we use+arrays for our input data.++Please see the file [WordCountParallel.hs][] for the complete working+code for this example, including the imports that we have omitted below.++First we create a new data type `Counts` that holds all the context.++```haskell docspec+>>> :{+-- Counts lines words chars lastCharWasSpace+data Counts = Counts !Int !Int !Int !Bool deriving Show+:}+>>> :{+{-# INLINE count #-}+count :: Counts -> Char -> Counts+count (Counts l w c wasSpace) ch =+    let l1 = if ch == '\n' then l + 1 else l+        (w1, wasSpace1) =+            if isSpace ch+            then (w, True)+            else (if wasSpace then w + 1 else w, False)+    in Counts l1 w1 (c + 1) wasSpace1+:}+```++The `countArray` function counts the line, word, char counts in one chunk:++```haskell docspec+>>> import Streamly.Data.Array (Array)++>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Unicode.Stream as Unicode++>>> :{+countArray :: Array Word8 -> IO Counts+countArray arr =+      Array.read arr                                      -- Stream IO Word8+    & Unicode.decodeLatin1                                -- Stream IO Char+    & Stream.fold (Fold.foldl' count (Counts 0 0 0 True)) -- IO Counts+:}+```++Here the function `count` and the `Counts` data type are defined in the+`WordCount` helper module defined in [WordCount.hs][].++When combining the counts in two contiguous chunks, we need to check+whether the first element of the next chunk is a whitespace character+in order to determine if the same word continues in the next chunk or+whether the chunk starts with a new word. The `partialCounts` function+adds a `Bool` flag to `Counts` returned by `countArray` to indicate+whether the first character in the chunk is a space.++```haskell docspec+>>> :{+partialCounts :: Array Word8 -> IO (Bool, Counts)+partialCounts arr = do+    let r = Array.getIndex 0 arr+    case r of+        Just x -> do+            counts <- countArray arr+            return (isSpace (chr (fromIntegral x)), counts)+        Nothing -> return (False, Counts 0 0 0 True)+:}+```++`addCounts` then adds the counts from two consecutive chunks:++```haskell docspec+>>> :{+addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)+addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =+    let wcount =+            if not ws1 && not sp2 -- No space between two chunks.+            then w1 + w2 - 1+            else w1 + w2+     in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)+:}+```++To count in parallel we now only need to divide the stream into arrays,+apply our counting function to each array, and then combine the counts+from each chunk.++```haskell docspec+>>> :set -XFlexibleContexts+>>> import GHC.Conc (numCapabilities)+>>> import qualified Streamly.Data.Stream.Prelude as Stream++>>> :{+wc :: Path -> IO (Bool, Counts)+wc file = do+      File.readChunks file             -- Stream IO (Array Word8)+    & Stream.parMapM cfg partialCounts -- Stream IO (Bool, Counts)+    & Stream.fold add                  -- IO (Bool, Counts)++    where++    cfg = Stream.maxThreads numCapabilities . Stream.ordered True+    add = Fold.foldl' addCounts (False, Counts 0 0 0 True)+:}+```++We can replace `parMapM` with `mapM` to get a serial version of the program.++A benchmark with 2 CPUs:++```+$ time WordCount-hs-parallel gutenberg-500MB.txt+11242220 97050938 574714449 gutenberg-500MB.txt++real    0m1.443s+user    0m2.095s+sys     0m0.202s+```++These example programs have assumed ASCII encoded input data.  For UTF-8+streams, we have a [concurrent wc implementation][WordCountParallelUTF8.hs]+with UTF-8 decoding.  This concurrent implementation performs as well+as the standard `wc` program in serial benchmarks. In concurrent mode+[Streamly][]'s implementation can utilise multiple processing cores if+these are present, and can thereby run much faster than the standard+binary.++Streamly provides concurrency facilities similar+to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and+[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative+style of expression.  With Streamly you can write concurrent programs+with ease, with support for different types of concurrent scheduling.++### A Concurrent Network Server++We now move to a slightly more complicated example: we simulate a+dictionary lookup server which can serve word meanings to multiple+clients concurrently.++Please see the file [WordServer.hs][] for the complete code for this+example.++```haskell docspec+>>> import Control.Concurrent (threadDelay)+>>> import Control.Exception (finally)+>>> import Network.Socket (Socket, close)++>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Network.Inet.TCP as TCP+>>> import qualified Streamly.Network.Socket as Socket+>>> import qualified Streamly.Unicode.Stream as Unicode++>>> :{+-- Simulate network/db query by adding a delay.+fetch :: String -> IO (String, String)+fetch w = threadDelay 1000000 >> return (w,w)+:}++>>> :{+-- Read lines of whitespace separated list of words from a socket, fetch the+-- meanings of each word concurrently and return the meanings separated by+-- newlines, in same order as the words were received. Repeat until the+-- connection is closed.+lookupWords :: Socket -> IO ()+lookupWords sk =+      Socket.read sk                             -- Stream IO Word8+    & Unicode.decodeLatin1                       -- Stream IO Char+    & Stream.wordsBy isSpace Fold.toList         -- Stream IO String+    & Stream.parMapM cfg fetch                   -- Stream IO (String, String)+    & fmap show                                  -- Stream IO String+    & Stream.intersperse "\n"                    -- Stream IO String+    & Unicode.encodeStrings Unicode.encodeLatin1 -- Stream IO (Array Word8)+    & Stream.fold (Socket.writeChunks sk)++    where++    cfg = Stream.ordered True+:}++>>> :{+serve :: Socket -> IO ()+serve sk = finally (lookupWords sk) (close sk)+:}++>>> :{+-- | Run a server on port 8091. Accept and handle connections concurrently. The+-- connection handler is "serve" (i.e. lookupWords).  You can use "telnet" or+-- "nc" as a client to try it out.+main :: IO ()+main =+      TCP.accept 8091         -- Stream IO Socket+    & Stream.parMapM id serve -- Stream IO ()+    & Stream.fold Fold.drain  -- IO ()+:}+```++### Merging Incoming Streams++In the next example, we show how to merge logs coming from multiple+nodes in your network.  These logs are merged at line boundaries and+the merged logs are written to a file or to a network destination.+This example uses the `concatMapWith` combinator to merge multiple+streams concurrently.++Please see the file [MergeServer.hs][] for the complete working code,+including the imports that we have omitted below.++<!--+Docspec bug: For some reason if we add the signature of the function the+definition is not registered and goes out of scope. This behaviour is consistent+but I'm unable to figure out the pattern yet.+-->+```haskell docspec+>>> import Streamly.Data.Stream (Stream)+>>> import System.IO (IOMode(AppendMode), Handle, withFile)++>>> import qualified Streamly.Network.Socket as Socket+>>> import qualified Streamly.FileSystem.Handle as Handle++>>> :{+-- | Read a line stream from a socket.+-- Note: lines are buffered, and we could add a limit to the+-- buffering for safety.+-- readLines :: Socket -> Stream IO (Array Char)+readLines sk =+    Socket.read sk       -- Stream IO Word8+  & Unicode.decodeLatin1 -- Stream IO Char+  & Stream.foldMany line -- Stream IO (Array Char)++  where++  line = Fold.takeEndBy (== '\n') Array.create+:}++>>> :{+-- recv :: Socket -> Stream IO (Array Char)+recv sk = Stream.finallyIO (close sk) (readLines sk)+:}++>>> :{+-- | Starts a server at port 8091 listening for lines with space separated+-- words. Multiple clients can connect to the server and send streams of lines.+-- The server handles all the connections concurrently, merges the incoming+-- streams at line boundaries and writes the merged stream to a file.+-- server :: Handle -> IO ()+server file =+      TCP.accept 8090                              -- Stream IO Socket+    & Stream.parConcatMap (Stream.eager True) recv -- Stream IO (Array Char)+    & Stream.unfoldEach Array.reader               -- Stream IO Char+    & Unicode.encodeLatin1                         -- Stream IO Word8+    & Stream.fold (Handle.write file)              -- IO ()+:}++>>> :{+main :: IO ()+main = withFile "output.txt" AppendMode server+:}+```++### Listing Directories Recursively/Concurrently++Our next example lists a directory tree recursively, and concurrently.++This example uses the tree traversing combinator `parConcatIterate`.  This+combinator maps a stream generator function on the input stream and then+recursively on the generated stream as well and flattens the results. We map a+directory to a stream generating its children and a file to a nil stream. This+results in a concurrent recursive depth first traversal of the directory tree.++Please see [ListDir.hs][] for the complete working code.++```haskell docspec+>>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))+>>> import qualified Streamly.Internal.FileSystem.DirIO as Dir (readEitherPaths)++>>> :set -XQuasiQuotes+>>> import Streamly.FileSystem.Path (path)+>>> import qualified Streamly.FileSystem.Path as Path+>>> import Data.Bifunctor(bimap)++>>> :{+main :: IO ()+main = do+    hSetBuffering stdout LineBuffering+    let start = Stream.fromPure (Left [path|.|])+        f = either (Dir.readEitherPaths id) (const Stream.nil)+        ls = Stream.parConcatIterate id f start+     in Stream.fold (Fold.drainMapM (print . bimap Path.toString Path.toString)) ls+:}+```++### Rate Limiting++For concurrent streams, a stream evaluation rate can be specified.  For+example, to print "tick" once every second you can simply write:++```haskell docspec+>>> import qualified Streamly.Internal.Data.Stream as Stream (timestamped)++>>> :{+main :: IO ()+main =+      Stream.parRepeatM (Stream.avgRate 1) (pure "tick") -- Stream IO String+    & Stream.timestamped                                 -- Stream IO (AbsTime, String)+    & Stream.fold (Fold.drainMapM print)                 -- IO ()+:}+```++Please see the file [Rate.hs][] for the complete working code.++The concurrency of the stream is automatically controlled to match the+specified rate. [Streamly][]'s rate control works precisely even at+throughputs as high as millions of yields per second.++For more sophisticated rate control needs please see the Streamly [reference+documentation][Streamly].++## Reactive Programming: Acid Rain Game++### Objective of the Game++The game starts with a certain measure of health of the player. As time+passes the health of the player keeps on deteriorating because acid rain is+going on. If the health reaches 0 the player dies and the game is over. If the+player types "potion" on the CLI, the health is improved, the game continues if+the player keeps typing potion rapidly enough. If the player types "harm"+instead the health of the player deteriorates and the player dies sooner. If+the player types "quit" then the game ends.++### Importing Required Modules++Let's first import the required modules from `streamly` and `base`.++```haskell+{-# LANGUAGE FlexibleContexts #-}+import Control.Monad.IO.Class (MonadIO(liftIO))+import Control.Monad.State (MonadState, get, modify)+import Data.Function ((&))+import Streamly.Data.Stream.Prelude (MonadAsync, Stream)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream.Prelude as Stream+```++### Events++The possible events in the system are represented by the `Event` data type.+Acid rain generates the `Harm` event, typing "potion" on the CLI generates the+`Heal` event, typing "harm" generates the `Harm` event, and typing "quit"+generates the `Quit` event. Harm and Heal events have an integer associated+which represents the degree of harm or healing.++```haskell+data Event = Quit | Harm Int | Heal Int deriving (Eq, Show)+```++This application has two independent and concurrent sources of event+streams, `acidRain` and `userAction`.++### Acid Rain Stream++Now let's simulate acid rain. The acidRain function below generates a stream of+`Harm 1` events, one event is generated per second.++```haskell+acidRain :: MonadAsync m => Stream m Event+acidRain = Stream.parRepeatM (Stream.constRate 1) (return $ Harm 1)+```++### User Event Stream++The second stream is the stream of events generated by the user by typing+commands on the CI. The `userAction` function reads the standard input,+interprets the command typed and generates the appropriate event. It keeps+doing this forever, this is an infinite stream.++```haskell+userAction :: MonadAsync m => Stream m Event+userAction = Stream.repeatM $ liftIO askUser++    where++    askUser = do+        command <- getLine+        case command of+            "potion" -> return (Heal 10)+            "harm"   -> return (Harm 10)+            "quit"   -> return Quit+            _        -> putStrLn "Type potion or harm or quit" >> askUser+```++### Combined Stream++Now let's combine the streams generated by acid rain and the stream generated+by the CLI. Both the streams should be generated concurrently, therefore, we+use the `parList` function to combine them, this function combines a list of+streams concurrently. We use the `eager True` option to ensure that both the+streams are evaluated as soon as possible.++```haskell+parallel :: MonadAsync m => [Stream m a] -> Stream m a+parallel = Stream.parList (Stream.eager True)++eventStream :: MonadAsync m => Stream m Event+eventStream = parallel [userAction, acidRain]+```++### Process Health Events++The `runEvents` function below maintains the health of the player as an integer+value in the `State` monad. It maps the `processEvents` function on the event+stream. The `Harm` or `Heal` events decrement or increment the player health+value appropriately. If we encounter a `Quit` event the function returns `Done`+otherwise it returns `Continue`. The resulting stream is a stream of `Result`+values.++```haskell+data Result = Continue | Done++runEvents :: (MonadAsync m, MonadState Int m) => Stream m Result+runEvents = Stream.mapM processEvents eventStream++    where++    processEvents event =+        case event of+            Harm n -> modify (\h -> h - n) >> return Continue+            Heal n -> modify (\h -> h + n) >> return Continue+            Quit -> return Done+```++### Check the Player Status++The `runEvents` function above returns a stream of results after processing the+health events. The stream consists of results indicating whether the game+should continue or end, the `State` monad supplies the current health of the+player.++Now we map the `getStatus` function on the `Result` stream. If we encounter a+`Done` in the result stream then it means the user has quit the game, so we+return `GameOver`, if the health of the player is 0 or less then the player has+died and we return `GameOver`, otherwise we return `Alive`.++```haskell+data Status = Alive | GameOver deriving Eq++getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status+getStatus result =+    case result of+        Done  -> liftIO $ putStrLn "You quit!" >> return GameOver+        Continue -> do+            h <- get+            liftIO+                $ if (h <= 0)+                  then putStrLn "You die!" >> return GameOver+                  else putStrLn ("Health = " <> show h) >> return Alive+```++### Tying it all Together++We start with the `Result` stream using the `runEvents` function. Then we map+the `getStatus` function on this stream and turn it into a `Status` stream.+Then we run the `State` monad using `runStateT`, supplying the initial health+to be 60, the resulting stream is a tuple of (health, status) in the IO monad.+We then discard the health and just keep the status, resulting in a `Status`+stream. We then fold this `Status` stream using the `takeEndBy` fold, this fold+terminates as soon as a `GameOver` value is encountered in the stream.++```haskell+main :: IO ()+main = do+    putStrLn "Your health is deteriorating due to acid rain,\+             \ type \"potion\" or \"quit\""+    runEvents                        -- Stream (StateT Int IO) Result+        & Stream.mapM getStatus      -- Stream (StateT Int IO) Status+        & Stream.runStateT (pure 60) -- Stream IO (Int, Status)+        & fmap snd                   -- Stream IO Status+        & Stream.fold (Fold.takeEndBy (== GameOver) Fold.drain) -- IO ()+    return ()+```++### Complete Working Example++You can find a complete working source of this example in the+streamly-examples repo as+[AcidRain.hs](https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs).+The idea of this game example has been taken from Gabriella Gonzalez's+[pipes-concurrency](https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html)+package.++## Reactive Programming: Circling Square++For a simple graphical example where we generate an animation by+rendering a graphics frame periodically, see the SDL based circling+square example adapted from Yampa in+[CirclingSquare.hs](https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs).++### More Examples++If you would like to view more examples, please visit the [Streamly+Examples][streamly-examples] web page.++<!--+### Further Reading++* [Streaming Benchmarks][streaming-benchmarks]+* [Concurrency Benchmarks][concurrency-benchmarks]+* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)+* [Other Guides](/)+* [Streamly Homepage][Streamly]+-->++<!--+Link References.+-->++[Streamly]: https://streamly.composewell.com/+[streamly-examples]: https://github.com/composewell/streamly-examples+[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks+[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks++<!--+Keep all the unstable links here so that they can be updated to stable+links (for online docs) before we release.+-->++<!-- examples -->+[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs+[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs+[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c+[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs+[WordCountParallelUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallelUTF8.hs+[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs+[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs+[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs+[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs+[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs++<!-- local files -->+[LICENSE]: /LICENSE+[CONTRIBUTING.md]: /CONTRIBUTING.md+[docs]: docs/
+ docs/User/Tutorials/performance-considerations.md view
@@ -0,0 +1,123 @@+# Performance Considerations++<!--+CPS-vs-Direct++# High performance code.++Use examples to illustrate.++## Direct encpasulated in CPS++Direct style modules provide the highest performance with static fusion. CPS+style modules provide dynamic composition and building/consuming of streams+with dependencies.++The basic principle is always compose using the fused modules as long as you+can. When we cannot we wrap them in cps. In general the outer structure of the+program is CPS and the inner structure is direct.++When using streams, we generally build/process small segments using the direct+style streams, we store the segments in chunks of arrays, wrap these arrays+into StreamK to build larger streams.++Similarly, we process larger CPS streams of arrays using CPS ParserK, process+the smaller segments within using direct style parser as much as we can. When+we need to express dependencies during processing i.e. we need monad then we+wrap the direct processing in CPS.++So we have the entire outline of the processing as CPS which encapsulates small+islands of direct style processing.++## Stream vs StreamK++The CPS overhead is per element, the smaller the elements, more in numbers, the+more is the overhead. Thus we want to minimize CPS and maximize direct style.+So we keep chunks in outer CPS StreamK and process those chunks using the inner+Stream. The direct processing is extermely efficient but it has to fuse+statically.++We we use fromStream (streamd), we are converting the stream to CPS and now+each element of the stream will pass through CPS, each elements will have a+constant CPS overhead. Thus it is better if we CPS a stream with fewer elements+of larger size rather than a large number of elements.++When we use toStream (streamk), we do not make the performance better, the+overhead remains the same as each element is passing through CPS anyway. We are+just processing the elements vis non-cps stream functions.++Therefore once we made a stream CPS, it does not make any difference if we make+it direct again or not. From performance perspective it is a one-way street.++The same arguments apply to Parser vs ParserK.+-->++## Streams++From performance behavior perspective, the stream operations can be divided+into three categories:++* Byte level loops: Fused streams as the lowest level building blocks.+* Chunk level loops: CPS streams as scalable wrappers to wrap fused streams.+* Thread level loops: Byte or chunk level loops evaluated in multiple threads.++| Fused  | CPS     | Concurrent Combinators       |+|--------|---------|------------------------------|+| Stream | StreamK | Streamly.Data.Stream.Prelude |+| Fold   | ParserK | Streamly.Data.Fold.Prelude   |+| Parser | ParserK |                              |+<!-- | Scan   | PipeK   | Streamly.Data.Scan.Prelude   | -->++## Fused Streams++The fused stream types provide the statically optimized loops giving the+highest performance with no function calls, thus no memory allocations for+wrapping constructors. Such loops provide C like performance.++## CPS Streams++In many cases you cannot determine the loops statically, in which case a+function call overhead or constructor allocation cannot be avoided. Note+this is not Haskell specific, even in C such cases would require a+function call overhead.  For such cases we have stream types which use+function composition rather than constructor fusion. In general we use+such streams to generate large chunks of data which is then processed by+fused streams loops embedded in CPS streams. Because of larger chunks+the number of function calls, therefore, the function call overhead due+to CPS streams is reduced.++## Concurrent Combinators++Concurrent streams use concurrency channels to evaluate streams+concurrently.  Concurrent combinators are provided corresponding to most+serial stream combinator for concurrent evaluation.  These combinators+consume fused or CPS streams, process them in a multithreaded manner and+generate a fused or CPS stream where the output is a stream.++## Arrays++Streams are for processing data, therefore, performance of streams+mostly involves CPU optimization.  Arrays are for storing data,+therefore, performance of arrays mostly involves memory aspects e.g.+boxed or unboxed, pinned or unpinned.++For highest performance we recommend the use of unboxed arrays. Unboxed+arrays store data without an additional heap pointer wrapper+(boxing). The arrays in the following modules are unboxed arrays:++* Streamly.Data.Array+* Streamly.Data.MutArray+* Streamly.Data.RingArray++For storing boxed heap objects, boxed arrays are provided in the following+modules:++* Streamly.Data.Array.Generic+* Streamly.Data.MutArray.Generic++Unboxed arrays can be pinned (cannot be moved by GC) or+unpinned. However, pinned or unpinned nature of the memory is not+statically typed in the array type. The same array may be created in+pinned or unpinned memory, an unpinned array can be dynamically moved+to pinned memory or vice-versa. For this purpose pinned or unpinned+versions of functions are provided in the unboxed array modules.
− docs/User/Tutorials/quick-overview.md 
@@ -1,517 +0,0 @@-<!---(c) 2017, Composewell Technologies and Contributors-SPDX-License-Identifer: BSD-3-Clause--->--# [Streamly][] Quick Tutorial-## About This Document--This guide introduces programming with [Streamly][] using a few practical-examples:--*  We will start with a simple program that [counts the number of words-   in a text](#modular-word-counting). We will then transform this program-   into a [concurrent](#concurrent-word-counting) program that can efficiently-   use multiprocessing hardware.-*  Next, we will create a [concurrent network-   server](#a-concurrent-network-server). We then show-   how to write a network server that [merges multiple-   streams](#merging-incoming-streams) concurrently.-*  Our third example shows how to list a directory tree concurrently,-   by reading [multiple directories in-   parallel](#listing-directories-recursivelyconcurrently).-*  Finally, we will look at how to [rate limit](#rate-limiting) stream-   processing.--It [concludes](#further-reading) with suggestions for further reading.--## Getting Started--### Installing Streamly--If you wish to follow along and run examples in this guide, please see-the [Before You Begin](/docs/User/Tutorials/before-you-begin.md) guide-for instructions on how to use the `streamly` package interactively or-in a project.--### An overview of the types used in these examples--As an expository device, we have indicated the types at the intermediate-stages of stream computations as comments in the examples below.-The meaning of these types are:--* A `Stream IO a` is a representation of a sequence of values of type-  `a` in the IO Monad.-* A `Fold IO a b` is a representation of a function that converts a stream of-  type `a` to a final accumulator of type `b` in the IO Monad.--## The Examples--The code snippets below should work in GHCi if all of those are typed-in sequence.  For brevity, imports that are already used in earlier-snippets are omitted from the latter ones.--### Modular Word Counting--A `Fold` in Streamly is a composable stream consumer.  For our first-example, we will use `Fold`s to count the number of bytes, words and lines-present in a file.  We will then compose individual `Fold`s together to-count words, bytes and lines at the same time.--Please see the file [WordCountModular.hs][] for the complete example-program.--#### Count Bytes (wc -c)--We start with a code fragment that counts the number of bytes in a file:--```haskell ghci-import Data.Function ((&))--import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Data.Stream as Stream-import qualified Streamly.FileSystem.File as File--wcb :: String -> IO Int-wcb file =-    File.read file           -- Stream IO Word8-  & Stream.fold Fold.length  -- IO Int-```--### Count Lines (wc -l)--The next code fragment shows how to count the number of lines in a file:--```haskell ghci-import Data.Word (Word8)-import Streamly.Data.Fold (Fold)---- ASCII character 10 is a newline.-countl :: Int -> Word8 -> Int-countl n ch = if ch == 10 then n + 1 else n---- The `nlines` fold accepts a stream of `Word8` and returns a line count (`Int`).-nlines :: Monad m => Fold m Word8 Int-nlines = Fold.foldl' countl 0--wcl :: String -> IO Int-wcl file =-    File.read file     -- Stream IO Word8-  & Stream.fold nlines -- IO Int-```--### Count Words (wc -w)--Our final code fragment counts the number of whitespace-separated words-in a stream:--```haskell ghci-import Data.Char (chr, isSpace)--countw :: (Int, Bool) -> Word8 -> (Int, Bool)-countw (n, wasSpace) ch =-    if isSpace $ chr $ fromIntegral ch-    then (n, True)-    else (if wasSpace then n + 1 else n, False)---- The `nwords` fold accepts a stream of `Word8` and returns a word count (`Int`).-nwords :: Monad m => Fold m Word8 Int-nwords = fst <$> Fold.foldl' countw (0, True)--wcw :: String -> IO Int-wcw file =-    File.read file      -- Stream IO Word8-  & Stream.fold nwords  -- IO Int-```--### Counting Bytes, Words and Lines Together--By using the `Tee` combinator we can compose the three folds that count-bytes, lines and words individually into a single fold that counts all-three at once.  The applicative instance of `Tee` distributes its input-to all the supplied folds (`Fold.length`, `nlines`, and `nwords`) and-then combines the outputs from the folds using the supplied combiner-function (`(,,)`).--```haskell ghci-import Streamly.Data.Fold (Tee(..))---- The fold accepts a stream of `Word8` and returns the three counts.-countAll :: Fold IO Word8 (Int, Int, Int)-countAll = unTee $ (,,) <$> Tee Fold.length <*> Tee nlines <*> Tee nwords--wc :: String -> IO (Int, Int, Int)-wc file =-    File.read file       -- Stream IO Word8-  & Stream.fold countAll -- IO (Int, Int, Int)-```--This example demonstrates the excellent modularity offered by-[Streamly][]'s simple and concise API.--### The Performance of Word Counting--We compare two equivalent implementations: one using [Streamly][],-and the other using C.--The performance of the [Streamly word counting-implementation][WordCount.hs] (using ghc-9.4.4 and fusion-plugin) is:--```-$ time WordCount-hs gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m2.033s-user    0m1.821s-sys     0m0.209s-```--The performance of an equivalent [wc implementation in C][WordCount.c] is:--```-$ time WordCount-c gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m2.113s-user    0m1.928s-sys     0m0.185s-```--### Concurrent Word Counting--In our next example we show how the task of counting words, lines,-and bytes could be done in parallel on multiprocessor hardware.--To count words in parallel we first divide the stream into chunks-(arrays), do the counting within each chunk, and then add all the-counts across chunks.  We use the same code as above except that we use-arrays for our input data.--Please see the file [WordCountParallel.hs][] for the complete working-code for this example, including the imports that we have omitted below.--First we create a new data type `Counts` that holds all the context.--```haskell ghci--- Counts lines words chars lastCharWasSpace-data Counts = Counts !Int !Int !Int !Bool deriving Show--{-# INLINE count #-}-count :: Counts -> Char -> Counts-count (Counts l w c wasSpace) ch =-    let l1 = if ch == '\n' then l + 1 else l-        (w1, wasSpace1) =-            if isSpace ch-            then (w, True)-            else (if wasSpace then w + 1 else w, False)-    in Counts l1 w1 (c + 1) wasSpace1-```--The `countArray` function counts the line, word, char counts in one chunk:--```haskell ghci-import Streamly.Data.Array (Array)--import qualified Streamly.Data.Array as Array-import qualified Streamly.Unicode.Stream as Unicode--countArray :: Array Word8 -> IO Counts-countArray arr =-      Array.read arr                                      -- Stream IO Word8-    & Unicode.decodeLatin1                                -- Stream IO Char-    & Stream.fold (Fold.foldl' count (Counts 0 0 0 True)) -- IO Counts-```--Here the function `count` and the `Counts` data type are defined in the-`WordCount` helper module defined in [WordCount.hs][].--When combining the counts in two contiguous chunks, we need to check-whether the first element of the next chunk is a whitespace character-in order to determine if the same word continues in the next chunk or-whether the chunk starts with a new word. The `partialCounts` function-adds a `Bool` flag to `Counts` returned by `countArray` to indicate-whether the first character in the chunk is a space.--```haskell ghci-partialCounts :: Array Word8 -> IO (Bool, Counts)-partialCounts arr = do-    let r = Array.getIndex 0 arr-    case r of-        Just x -> do-            counts <- countArray arr-            return (isSpace (chr (fromIntegral x)), counts)-        Nothing -> return (False, Counts 0 0 0 True)-```--`addCounts` then adds the counts from two consecutive chunks:--```haskell ghci-addCounts :: (Bool, Counts) -> (Bool, Counts) -> (Bool, Counts)-addCounts (sp1, Counts l1 w1 c1 ws1) (sp2, Counts l2 w2 c2 ws2) =-    let wcount =-            if not ws1 && not sp2 -- No space between two chunks.-            then w1 + w2 - 1-            else w1 + w2-     in (sp1, Counts (l1 + l2) wcount (c1 + c2) ws2)-```--To count in parallel we now only need to divide the stream into arrays,-apply our counting function to each array, and then combine the counts-from each chunk.--```haskell ghci-{-# LANGUAGE FlexibleContexts #-}--import GHC.Conc (numCapabilities)-import qualified Streamly.Data.Stream.Prelude as Stream--wc :: String -> IO (Bool, Counts)-wc file = do-      File.readChunks file             -- Stream IO (Array Word8)-    & Stream.parMapM cfg partialCounts -- Stream IO (Bool, Counts)-    & Stream.fold add                  -- IO (Bool, Counts)--    where--    cfg = Stream.maxThreads numCapabilities . Stream.ordered True-    add = Fold.foldl' addCounts (False, Counts 0 0 0 True)-```--We can replace `parMapM` with `mapM` to get a serial version of the program.--A benchmark with 2 CPUs:--```-$ time WordCount-hs-parallel gutenberg-500MB.txt-11242220 97050938 574714449 gutenberg-500MB.txt--real    0m1.443s-user    0m2.095s-sys     0m0.202s-```--These example programs have assumed ASCII encoded input data.  For UTF-8-streams, we have a [concurrent wc implementation][WordCountParallelUTF8.hs]-with UTF-8 decoding.  This concurrent implementation performs as well-as the standard `wc` program in serial benchmarks. In concurrent mode-[Streamly][]'s implementation can utilise multiple processing cores if-these are present, and can thereby run much faster than the standard-binary.--Streamly provides concurrency facilities similar-to [OpenMP](https://en.wikipedia.org/wiki/OpenMP) and-[Cilk](https://en.wikipedia.org/wiki/Cilk) but with a more declarative-style of expression.  With Streamly you can write concurrent programs-with ease, with support for different types of concurrent scheduling.--### A Concurrent Network Server--We now move to a slightly more complicated example: we simulate a-dictionary lookup server which can serve word meanings to multiple-clients concurrently.--Please see the file [WordServer.hs][] for the complete code for this-example.--```haskell ghci-import Control.Concurrent (threadDelay)-import Control.Exception (finally)-import Network.Socket (Socket, close)--import qualified Streamly.Data.Parser as Parser-import qualified Streamly.Network.Inet.TCP as TCP-import qualified Streamly.Network.Socket as Socket-import qualified Streamly.Unicode.Stream as Unicode---- Simulate network/db query by adding a delay.-fetch :: String -> IO (String, String)-fetch w = threadDelay 1000000 >> return (w,w)---- Read lines of whitespace separated list of words from a socket, fetch the--- meanings of each word concurrently and return the meanings separated by--- newlines, in same order as the words were received. Repeat until the--- connection is closed.-lookupWords :: Socket -> IO ()-lookupWords sk =-      Socket.read sk                             -- Stream IO Word8-    & Unicode.decodeLatin1                       -- Stream IO Char-    & Stream.wordsBy isSpace Fold.toList         -- Stream IO String-    & Stream.parMapM cfg fetch                   -- Stream IO (String, String)-    & fmap show                                  -- Stream IO String-    & Stream.intersperse "\n"                    -- Stream IO String-    & Unicode.encodeStrings Unicode.encodeLatin1 -- Stream IO (Array Word8)-    & Stream.fold (Socket.writeChunks sk)--    where--    cfg = Stream.ordered True--serve :: Socket -> IO ()-serve sk = finally (lookupWords sk) (close sk)---- | Run a server on port 8091. Accept and handle connections concurrently. The--- connection handler is "serve" (i.e. lookupWords).  You can use "telnet" or--- "nc" as a client to try it out.-main :: IO ()-main =-      TCP.accept 8091         -- Stream IO Socket-    & Stream.parMapM id serve -- Stream IO ()-    & Stream.fold Fold.drain  -- IO ()-```--### Merging Incoming Streams--In the next example, we show how to merge logs coming from multiple-nodes in your network.  These logs are merged at line boundaries and-the merged logs are written to a file or to a network destination.-This example uses the `concatMapWith` combinator to merge multiple-streams concurrently.--Please see the file [MergeServer.hs][] for the complete working code,-including the imports that we have omitted below.--```haskell ghci-{-# LANGUAGE FlexibleContexts #-}--import Streamly.Data.Stream (Stream)-import System.IO (IOMode(AppendMode), Handle, withFile)--import qualified Streamly.Network.Socket as Socket-import qualified Streamly.FileSystem.Handle as Handle---- | Read a line stream from a socket.--- Note: lines are buffered, and we could add a limit to the--- buffering for safety.-readLines :: Socket -> Stream IO (Array Char)-readLines sk =-    Socket.read sk       -- Stream IO Word8-  & Unicode.decodeLatin1 -- Stream IO Char-  & Stream.foldMany line -- Stream IO (Array Char)--  where--  line = Fold.takeEndBy (== '\n') Array.write--recv :: Socket -> Stream IO (Array Char)-recv sk = Stream.finallyIO (close sk) (readLines sk)---- | Starts a server at port 8091 listening for lines with space separated--- words. Multiple clients can connect to the server and send streams of lines.--- The server handles all the connections concurrently, merges the incoming--- streams at line boundaries and writes the merged stream to a file.-server :: Handle -> IO ()-server file =-      TCP.accept 8090                              -- Stream IO Socket-    & Stream.parConcatMap (Stream.eager True) recv -- Stream IO (Array Char)-    & Stream.unfoldMany Array.reader               -- Stream IO Char-    & Unicode.encodeLatin1                         -- Stream IO Word8-    & Stream.fold (Handle.write file)              -- IO ()--main :: IO ()-main = withFile "output.txt" AppendMode server-```--### Listing Directories Recursively/Concurrently--Our next example lists a directory tree recursively, and concurrently.--This example uses the tree traversing combinator `parConcatIterate`.  This-combinator maps a stream generator function on the input stream and then-recursively on the generated stream as well and flattens the results. We map a-directory to a stream generating its children and a file to a nil stream. This-results in a concurrent recursive depth first traversal of the directory tree.--Please see [ListDir.hs][] for the complete working code.--```haskell ghci-import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-import qualified Streamly.Internal.FileSystem.Dir as Dir (readEitherPaths)--main :: IO ()-main = do-    hSetBuffering stdout LineBuffering-    let start = Stream.fromPure (Left ".")-        f = either Dir.readEitherPaths (const Stream.nil)-        ls = Stream.parConcatIterate id f start-     in Stream.fold (Fold.drainMapM print) ls-```--### Rate Limiting--For concurrent streams, a stream evaluation rate can be specified.  For-example, to print "tick" once every second you can simply write:--```haskell ghci-import qualified Streamly.Internal.Data.Stream as Stream (timestamped)--main :: IO ()-main =-      Stream.parRepeatM (Stream.avgRate 1) (pure "tick") -- Stream IO String-    & Stream.timestamped                                 -- Stream IO (AbsTime, String)-    & Stream.fold (Fold.drainMapM print)                 -- IO ()-```--Please see the file [Rate.hs][] for the complete working code.--The concurrency of the stream is automatically controlled to match the-specified rate. [Streamly][]'s rate control works precisely even at-throughputs as high as millions of yields per second.--For more sophisticated rate control needs please see the Streamly [reference-documentation][Streamly].--### Reactive Programming--Streamly supports reactive (time domain) programming because of its support for-declarative concurrency. Please see the `Streamly.Data.Stream.Prelude`-module for time-specific and sampling combinators.--The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate-reactive programming using [Streamly][].--### More Examples--If you would like to view more examples, please visit the [Streamly-Examples][streamly-examples] web page.--<!---### Further Reading--* [Streaming Benchmarks][streaming-benchmarks]-* [Concurrency Benchmarks][concurrency-benchmarks]-* Functional Conf 2019 [Video](https://www.youtube.com/watch?v=uzsqgdMMgtk) | [Slides](https://www.slideshare.net/HarendraKumar10/streamly-concurrent-data-flow-programming)-* [Other Guides](/)-* [Streamly Homepage][Streamly]--->--<!---Link References.--->--[Streamly]: https://streamly.composewell.com/-[streamly-examples]: https://github.com/composewell/streamly-examples-[streaming-benchmarks]: https://github.com/composewell/streaming-benchmarks-[concurrency-benchmarks]: https://github.com/composewell/concurrency-benchmarks--<!---Keep all the unstable links here so that they can be updated to stable-links (for online docs) before we release.--->--<!-- examples -->-[WordCountModular.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountModular.hs-[WordCount.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.hs-[WordCount.c]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCount.c-[WordCountParallel.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallel.hs-[WordCountParallelUTF8.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordCountParallelUTF8.hs-[WordServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/WordServer.hs-[MergeServer.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/MergeServer.hs-[ListDir.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/ListDir.hs-[Rate.hs]: https://github.com/composewell/streamly-examples/blob/master/examples/Rate.hs-[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs-[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs--<!-- local files -->-[LICENSE]: /LICENSE-[CONTRIBUTING.md]: /CONTRIBUTING.md-[docs]: docs/
+ docs/User/Tutorials/streamly-core.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0.0 0.0 700.0 699.9999999999998" height="700.0000" font-size="1" stroke-opacity="1" width="700.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-70.7071 h -212.1212 l -0.0000,70.7071 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,456.0606 l -0.0000,-44.1919 h -212.1212 l -0.0000,44.1919 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,433.9646)" dominant-baseline="middle" text-anchor="middle" stroke="none">Control.Exception</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,398.6111)" dominant-baseline="middle" text-anchor="middle" stroke="none">Resource Management</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,385.3535 l -0.0000,-141.4141 h -212.1212 l -0.0000,141.4141 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,385.3535 l -0.0000,-114.8990 h -212.1212 l -0.0000,114.8990 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,365.0253)" dominant-baseline="middle" text-anchor="middle" stroke="none">String</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,327.9040)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,290.7828)" dominant-baseline="middle" text-anchor="middle" stroke="none">Parser</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,257.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unicode</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,456.0606 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,437.5000)" dominant-baseline="middle" text-anchor="middle" stroke="none">Path</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,400.3788)" dominant-baseline="middle" text-anchor="middle" stroke="none">Handle</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,363.2576)" dominant-baseline="middle" text-anchor="middle" stroke="none">DirIO</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,326.1364)" dominant-baseline="middle" text-anchor="middle" stroke="none">FileIO</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,289.0152)" dominant-baseline="middle" text-anchor="middle" stroke="none">Console.Stdio</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,257.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">File System</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,625.7576)" dominant-baseline="middle" text-anchor="middle" stroke="none">Serialize</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,588.6364)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unbox</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,551.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutByteArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Serialization</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,625.7576)" dominant-baseline="middle" text-anchor="middle" stroke="none">RingArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,588.6364)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutArray.Generic</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,551.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">MutArray</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Mutable</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,668.1818 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,607.1970)" dominant-baseline="middle" text-anchor="middle" stroke="none">Array.Generic</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,570.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Array</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,495.8333)" dominant-baseline="middle" text-anchor="middle" stroke="none">Immutable</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,469.3182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Arrays</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,201.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">ParserK</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Parser</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,127.2727)" dominant-baseline="middle" text-anchor="middle" stroke="none">Fold</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Consumption</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Scanl</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Transformation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,201.5152)" dominant-baseline="middle" text-anchor="middle" stroke="none">Unfold</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">StreamK</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,127.2727)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Generation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,45.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Streams</text></g><g stroke-linecap="butt" fill="rgb(173,216,230)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 c 0.0000,-21.9659 -35.6137,-39.7727 -79.5455 -39.7727c -43.9317,-0.0000 -79.5455,17.8069 -79.5455 39.7727c -0.0000,21.9659 35.6137,39.7727 79.5455 39.7727c 43.9317,0.0000 79.5455,-17.8069 79.5455 -39.7727Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,357.9545)" dominant-baseline="middle" text-anchor="middle" stroke="none">(types and modules)</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,342.0455)" dominant-baseline="middle" text-anchor="middle" stroke="none">streamly-core</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 h 15.9091 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,350.0000 l -10.6061,-6.1234 v 12.2468 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 270.4545,350.0000 l -15.9091,0.0000 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,350.0000 l 10.6061,6.1234 l -0.0000,-12.2468 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,389.7727 l 0.0000,55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,456.0606 l 6.1234,-10.6061 l -12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,310.2273 l 0.0000,-55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,243.9394 l -6.1234,10.6061 l 12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g></svg>
+ docs/User/Tutorials/streamly-ecosystem.md view
@@ -0,0 +1,111 @@+# Streamly Ecosystem++The Streamly ecosystem is a collection of packages built on top of+Streamly, extending its core with higher-level functionality for+real-world programming.++For a combined view of the reference documentation across all ecosystem+packages, visit:+👉 [Streamly Module Listing](https://streamly.composewell.com/module-listing.html)++## streamly-process++**`streamly-process`** lets you use operating system (OS) commands in+Haskell programs as if they were native functions, by treating their+inputs and outputs as Haskell streams. This makes it easy to write+high-level Haskell scripts that perform tasks similar to shell pipelines+but with **C-like performance, strong safety guarantees, modularity, and+refactorability**.++For example, the shell command:++```bash+echo "hello world" | tr [a-z] [A-Z]+```++can be expressed in Haskell as:++<!--+Not exactly sure what the clean way is to import packages. We need to launch the+ghci session with the required packages.+-->+```+>>> :{+   Command.toBytes [str|echo "hello world"|] -- Stream IO Word8+ & Command.pipeBytes [str|tr [a-z] [A-Z]|]   -- Stream IO Word8+ & Stream.fold Stdio.write                   -- IO ()+:}+HELLO WORLD+```++👉 [streamly-process on GitHub](https://github.com/composewell/streamly-process)++## streamly-coreutils++**`streamly-coreutils`** reimplements GNU coreutils utilities as+composable Haskell functions—concurrent where possible. Examples include+`test`, `cp`, `ls`, `ln`, `mv`, `rm`, `touch`, `mkdir`, `pwd`, `cd`,+`stat`, `readlink`, `which`, `sleep`, and more.++This allows you to use familiar Unix-style tools directly within+streaming Haskell programs, combining the convenience of shell scripting+with the safety, modularity, and performance of Haskell.++👉 [streamly-coreutils on GitHub](https://github.com/composewell/streamly-coreutils)++## streamly-statistics++**`streamly-statistics`** offers functionality similar to the Haskell+`statistics` package, but with streaming APIs. Its unique strength is+support for **incremental statistical analysis on sliding windows of+data**, seamlessly integrated into streaming pipelines. This makes it+ideal for real-time analytics, monitoring systems, or any application+that processes continuous data streams.++👉 [streamly-statistics on GitHub](https://github.com/composewell/streamly-statistics)++## streamly-fsevents++**`streamly-fsevents`** provides a streaming interface to file system+events. It allows you to **watch files or directories for changes**—+such as creation, modification, deletion, or renaming—and consume those+events as Haskell streams. Internally, it uses efficient system+facilities like `inotify` on Linux for scalable event monitoring.++This makes it well-suited for building **real-time file watchers,+synchronization tools, live-reload servers, or monitoring pipelines**.++👉 [streamly-fsevents on GitHub](https://github.com/composewell/streamly-fsevents)++<!--+## streamly-lz4++Streaming APIs for lz4 compression and decompression.+-->++## Compatibility Packages++Streamly can interwork with other packages in the Haskell ecosystem+providing similar functionality. These packages enable the+interconversion.++### streamly-bytestring++Package for converting streamly `Array` type to the bytestring package's+`ByteString` type and vice-versa.++👉 [streamly-bytestring on GitHub](https://github.com/psibi/streamly-bytestring)++### streamly-text++Package for converting streamly `Array` type to the `text` package's+`Text` type and vice-versa.++👉 [streamly-text on GitHub](https://github.com/composewell/streamly-text)++### streamly-filepath++Package for converting streamly `Path` type to the `filepath` package's+`OsPath` type and vice-versa.++👉 [streamly-filepath on GitHub](https://github.com/composewell/streamly-filepath)
+ docs/User/Tutorials/streamly.svg view
@@ -0,0 +1,3 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"+    "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd"><svg xmlns="http://www.w3.org/2000/svg" viewBox="0.0 0.0 700.0 699.9999999999998" height="700.0000" font-size="1" stroke-opacity="1" width="700.0000" xmlns:xlink="http://www.w3.org/1999/xlink" stroke="rgb(0,0,0)" version="1.1"><defs></defs><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-212.1212 h -212.1212 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,668.1818 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,593.9394)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network.Inet.TCP</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,556.8182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network.Socket</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,469.3182)" dominant-baseline="middle" text-anchor="middle" stroke="none">Network</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-212.1212 h -636.3636 l -0.0000,212.1212 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 668.1818,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Fold.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,562.1212,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Consumption</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 456.0606,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Scanl.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Transformation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-185.6061 h -212.1212 l -0.0000,185.6061 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="1.4" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 243.9394,243.9394 l -0.0000,-159.0909 h -212.1212 l -0.0000,159.0909 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="13.257575757575752px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,164.3939)" dominant-baseline="middle" text-anchor="middle" stroke="none">Stream.Prelude</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,137.8788,71.5909)" dominant-baseline="middle" text-anchor="middle" stroke="none">Generation</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,45.0758)" dominant-baseline="middle" text-anchor="middle" stroke="none">Concurrent Streams</text></g><g stroke-linecap="butt" fill="rgb(173,216,230)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 429.5455,350.0000 c 0.0000,-21.9659 -35.6137,-39.7727 -79.5455 -39.7727c -43.9317,-0.0000 -79.5455,17.8069 -79.5455 39.7727c -0.0000,21.9659 35.6137,39.7727 79.5455 39.7727c 43.9317,0.0000 79.5455,-17.8069 79.5455 -39.7727Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" font-size="15.909090909090903px" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)" font-weight="bold"><text transform="matrix(1.0000,0.0000,0.0000,1.0000,350.0000,350.0000)" dominant-baseline="middle" text-anchor="middle" stroke="none">streamly</text></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,389.7727 l 0.0000,55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,456.0606 l 6.1234,-10.6061 l -12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="2.8" fill-opacity="0.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,310.2273 l 0.0000,-55.6818 "/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"><path d="M 350.0000,243.9394 l -6.1234,10.6061 l 12.2468,0.0000 Z"/></g><g stroke-linecap="butt" fill="rgb(0,0,0)" stroke-miterlimit="10.0" stroke-width="0.0" fill-opacity="1.0" stroke-opacity="1.0" stroke-linejoin="miter" stroke="rgb(0,0,0)"></g></svg>
+ docs/User/Tutorials/streams-as-loops.md view
@@ -0,0 +1,190 @@+# Streaming Pipelines as Functional Loops++Streaming pipelines are the functional equivalent of loops in imperative+programming.  In imperative programming when we have to process a+sequence of data items we run a loop over all the items. Each iteration+of the loop examines a single element of data to change the state of the+program or produce an output.++<!-- Write a C loop equivalent to the stream code below -->++## Data as Stream++In the streaming paradigm, we represent the user data that we have to+loop over as a stream.  A stream is a representation of potentially+infinite sequence of data items.++A finite stream consisting of integer data elements 1,2,3:++```haskell docspec+>>> import Streamly.Data.Stream (Stream)+>>> import qualified Streamly.Data.Stream as Stream+>>> s1 = Stream.enumerateFromTo 1 3 :: Stream IO Int+```++An infinite stream consisting of integers from 1 to infinity:++```haskell docspec+>>> s2 = Stream.enumerateFrom 1 :: Stream IO Int+```++## Stream Transformation++We have represented data as stream, now we have to operate on it. To+operate on the data in the stream we use stream transformation+functions, for example, if we have to increment each element in the+stream by one we use the `fmap` function. After applying the `fmap (+1)`+function on the stream we get an output stream in which each element of+the input stream is incremented by 1. Stream `s3` consists of elements+2,3,4:++```haskell docspec+>>> import Data.Function ((&))+>>> :{+s3 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+:}+```++Another example of a stream transformation operation is `take`, it trims+the stream to the specified number of elements. For example, the stream+`s4` in the code below consists of only two items 1,2:++```haskell docspec+>>> :{+s4 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+:}+```++## Modular Streaming Operations++Similar to `fmap` and `take` there are many transformation operations+available in the library to perform different type of operations on the+stream. Each operation performs a specific job. We can combine multiple such+operations successively in a pipeline of operations to perform a desired+operation on the stream. For example, if we want to increment each element by 1+and want to take only first two items, then we can do it as follows. The+resulting stream `s5` consists of items 2,4.++```haskell docspec+>>> :{+s5 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+:}+```++Each stream transformation operation maintains its own internal state+which is hidden from the programmer. In an imperative language loop we+will have to maintain the state explicitly in a monolithic loop, for+example if we have to stop after processing 2 elements we will have to+maintain a counter and check that counter in each iteration. Here we are+able to hide the state locally in each transformation operation and we+can build a larger processing loop by putting together smaller parts in+a modular fashion.++The programmer only needs to pick the operations required for the+job and put them together. The resulting code is highly modular,+maintainable and readable. You can add an operation in the pipeline+without worrying about breaking anything else as the state for each+operation is private and cannot be meddled with by the programmer.++## Stream Consumption++Previously, we looked at operations that transform a stream to another+stream. Now let us look at another class of operations that consume a+stream and produce a single value or a single structure from it. This is+known as consuming the stream or eliminating the stream. The entities+that consume the stream are called consumers or folds (they help fold a+stream into a single value).++The `sum` fold consumes a stream of integers and adds them all, when+done it returns the sum. The `Stream.fold` operation takes a stream+and a fold and connects them together, feeding the stream to the fold+and then returning the result. We refer to this operation as the fold+driver. The variable `total` contains the value `1+2+3` i.e. 6.++```haskell docspec+>>> import Streamly.Data.Fold as Fold+>>> :{+total <-+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold Fold.sum   -- IO Int+:}+```++## The Streaming Pipeline++Using all the operations described above we can create a data processing+pipeline that increments each data item one by 1, takes the first two+elements, adds them and prints the result:++```haskell docspec+>>> :{+main =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & fmap (+1)              -- Stream IO Int+      & Stream.take 2          -- Stream IO Int+      & Stream.fold Fold.sum   -- IO Int+      >>= print                -- IO ()+:}+```++The following snippet provides a simple stream composition example that reads+numbers from stdin, prints the squares of even numbers and exits if an even+number more than 9 is entered.++``` haskell ghci+>>> import qualified Streamly.Data.Stream as Stream++>>> :{+main = Stream.drain $+       Stream.repeatM getLine+     & fmap read+     & Stream.filter even+     & Stream.takeWhile (<= 9)+     & fmap (\x -> x * x)+     & Stream.mapM print+:}+```++## Data Flow Programming++We have demonstrated above how you can compose a pipeline of functions+or stream processors to process an input stream of data to produce an+output stream. We call it a form of dataflow programming as data flows+through the processing logic. In imperative programming there is no+clear separation of data and logic. The logic can arbitrarily examine+and mutate data which creates a problem due to complex interleaving of+state and logic in the program.++Imperative looping is a low level and monolithic concept, it is+difficult for programmers to implement and is error prone. Whereas+streams are high level, declarative, structured and modular way of+expressing what you usually do with low level loops. Streams allow+you to write different parts of the loop as modular combinators and+then compose them to create bigger loops. Streamly uses stream fusion+optimizations to ensure that the composed loop has the same performance+as a hand-written monolithic loop.++## Performance Optimizations++The streaming pipeline is translated into actual imperative loops by+the Haskell compiler GHC. The programmer writes a very high level+declarative code while the heavy lifting is done by the compiler to fuse+all that code together in a tight imperative loop.++You might think that the code above may not perform as well as a+handwritten code for the same job. But you will be surprised how+efficiently GHC optimizes this code using a technique called stream+fusion which is based on two important optimizations done by GHC namely,+case-of-case and spec-constructor. There are no intermediate streams,+no constructor allocations, all heap values are unboxed while being+processed in the loop, thus resulting in the same code as a C compiler+would generate from a handwritten C loop. Essentially, the imperative+loop is written by the compiler using the high level instructions+provided by the programmer.
+ docs/User/Tutorials/the-swiss-army-knife.md view
@@ -0,0 +1,335 @@+# Streamly: The Swiss Army Knife for Haskell+++<!--+![All your base are belong to us!](./all-your-base.jpg)+# All your package are belong to us!+Bring the docs from streamly-core/streamly cabal package description here.+-->++Streamly provides a comprehensive suite of functionality through+a **consistent, concise, and modular interface**, backed by+**high-performance APIs**. Designed from the ground up, it **minimizes+abstractions** while **maximizing functionality and efficiency**. By+unifying features from many disparate Haskell packages on Hackage—and+often outperforming them—**Streamly acts as a Swiss army knife for+Haskell programmers**.++Importantly, Streamly does **not** aim to replicate functionality that+already exists elsewhere. Instead, it focuses on creating **foundational+building blocks** that naturally deliver **broad, unified, and concise+capabilities** with **peak performance**. This approach embodies the+Haskell principle of **“don’t repeat yourself” (DRY)**, addressing+a gap often overlooked in the Haskell library ecosystem.++Below, we provide an overview of Streamly’s functionality and show+how its modular building blocks unify disparate features into a single,+coherent framework. Streamly offers a unified alternative to several+existing packages. For new projects, it can reduce dependency bloat,+enable concise and expressive solutions to domain-specific problems, and+often deliver better performance out of the box.++## Streaming++Streamly offers **high-performance, feature-rich streaming** and data+flow programming operations. We are briefly mentioning some of the+key capabilities here among many others.++### Three Core Abstractions++Streamly provides three types of streams, each one allows transformation and+stateful processing of sequential streams of data but they differ in how they+can be composed:++- **Producers (`Stream`)** – these are essentially generators or+  source of data streams, multiple sources can be combined to create+  a single source.+- **Transformers (`Scanl`)** – these are essentially pipes connecting sources+  to sources or sinks, multiple scans can be combined together such that+  a source stream can be split over multiple pipes and the resulting+  streams can be the combined back into a single source stream.+- **Consumers (`Fold`)** – these are essentially final consumers or sinks of+  data, multiple consumers can be combined together into a single+  consumer such that a source stream can be distributed to all consumers+  and the results can be combined.++**Parsers** are a specialization of folds that support backtracking+and errors handling.  Folds and parsers are **first-class building+blocks** for stateful data processing. Grouping, chunking and many other+operations over streams, scans and folds are implemented using folds and+parsers — making the library extremely versatile, modular, and yet+high-performing due to stream fusion.++### Nested and Structured Stream Processing++Streamly supports **nested stream processing** (the functional+equivalent of nested loops) in several styles:++- **Depth-first** – inner loops run to completion before the next+    outer loop iteration.+- **Breadth-first** – all outer loop iterations advance one step at a+    time.+- **Fair interleaving** – inner and outer loops advance fairly in+    parallel.++With `concatIterate`, the output of a stream can be fed back into+its input, allowing recursion and control flow at the stream level.+It can be used for traversing **trees and graphs breadth-first or+depth-first**. `mergeMapWith` merges streams pairwise to form balanced+merge trees, for example you can merge sorted data from many files using+this combinator.++### Sliding Windows and Sessions++**Sliding windows** are an integral part of scans and folds,+enabling incremental window based computations for use cases+such as **time-series analysis, statistical metrics, and trading+indicators**—without recomputing the results over the entire dataset.++Elements in streams can be **classified by keys** to route them to+different sessions, fold each substream differently in its own session,+and generate a stream of end results from these sessions.++### Expressiveness and Performance++These modular abstractions allow complex problems to be expressed in+**succinct and idiomatic way**. For example, merge sort in Streamly+is implemented in just a few lines of idiomatic code using only+general-purpose building blocks—yet the performance matches or exceeds+the highly optimized list implementation in base.++Streamly provides a unified, expressive, and high-level alternative to+stream processing packages like `streaming`, `conduit`, `pipes`, and+`foldl`, with unmatched performance.++## Concurrency++Streamly is built for concurrency, all abstractions are designed for+concurrency, it provides native concurrent evaluation of streams, scans+and folds. All the ways in which stream processing pipelines can be+composed with serial processing can also be composed with concurrent+processing.  For example, you can:++- Map a function over a stream concurrently.+- generate multiple streams in parallel and merge the results in a single+  stream.+- Split streams, scan each branch concurrently, and combine them back+  into a single stream.+- Distribute a stream to different concurrent folds and merge back the results.+- Traverse trees or graphs, feed output streams back to input for+  recursive processing, concurrently.+- Perform time-based operations such as sampling, throttling, or debouncing.+- Group items over time intervals or intersperse actions in a stream+  periodically.++Concurrent streaming with time based operations can be used to implement+programs based on functional reactive programming model.  The operations+you can perform with Streamly often overlap with what libraries like+**Apache Flink** provide, but in a **lightweight, unified, and purely+functional way**.++With all these facilities streamly allows you to express your domain+specific problems much more succinctly and effortlessly. For example,+the concurrent directory traversal written with streamly is just a+few lines of code, built from low level basic building blocks, and+outperforms rust based implementations.++Streamly is much more higher level alternative to low level packages like+async, pipes-concurrency, streamling-concurrency etc. Take a look at the+`Streamly.Data.Stream.Prelude`, `Streamly.Data.Scanl.Prelude`,+`Streamly.Data.Fold.Prelude` modules in the streamly package.++## Reactive Programming++Streamly supports reactive (time domain) programming because of its support for+declarative concurrency. Please see the `Streamly.Data.Stream.Prelude`+module for time-specific and time based sampling combinators.++Reactive programming is modeled beautifully using concurrent streaming in+streamly. It involves generation of streams of events, merging concurrent+streams and processing events concurrently.  Streamly provides native+high-level facilities to do all this easily.++The examples [AcidRain.hs][] and [CirclingSquare.hs][] demonstrate+reactive programming using [Streamly][].++[AcidRain.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/AcidRain.hs+[CirclingSquare.hs]: https://github.com/composewell/streamly-examples/tree/master/examples/CirclingSquare.hs++## Parsing++Parsing in Streamly is first-class, high-performance, and integrated+with streams.  Streamly treats parsers as core building blocks for+data processing. Many tasks—such as **sorting, chunking, and+structured transformations**—are expressed naturally with folds and+parsers. Parsers are not restricted to byte streams, any type of streams+can be parsed. It provides full-fledged parsing functionality equivalent+to the standard parser combinator libraries like `parsec`. Performance+is equivalent or better than some of the best performing libraries like+`attoparsec`.++## Prompt Resource Cleanup++One of the many challenges in a concurrent environment is safe,+correct and timely resource cleanup in all cases and races. Streamly+provides built-in prompt resource cleanup operations in a concurrent+environment. It provides basic IO level building blocks as well as+stream based resource management combinators, everything that you can do+with `resourcet` is built into the library.++## Lists and Strings++Streamly modules `Streamly.Data.Stream` and `Streamly.Data.Fold` cover+the entire functionality of `Data.List` from the `base` package. While+lists are sufficient and easy to use for many cases, it can be+problematic when you need to **interleave IO effects** such as tracing+or debug prints. Streamly streams provide the same interface as lists+but allow you to **inject IO effects anywhere** without buffering the+entire dataset in memory.  Additionally, **Streamly streams often+outperform lists** when combining transformations.++By virtue of its modularity it is able to express the string (stream)+splitting operations similar to the `split` package without any custom+implementation. In the same manner it implements search operations+similar to the `stringsearch` package.  For string search, `splitOnSeq`+and `takeEndBySeq` in Streamly use the **Rabin-Karp algorithm** for+fast pattern matching. Benchmarks show performance comparable to the+Rust `ripgrep` tool.  `Streamly.Unicode.String` also provides string+interpolation.++## Non-determinism and List Transformers++Streamly provides full list transformer functionality (e.g. equivalent+to the `ListT` from list-t package) and more.  It does not provide a+Monad instance for streams, as there are many possible ways to define+the bind operation.  Instead, it offers bind-style operations such as+'concatFor', 'concatForM', and their variants (e.g. fair interleaving+and breadth-first nesting). These can be used for convenient ListT-style+stream composition. Additionally, it provides applicative-style cross+product operations like 'cross' and its variants which are many times+faster than the monad style operations.++## Logic Programming++Streamly does not provide a 'LogicT'-style Monad instance, but it+offers comprehensive logic programming functionality.  Operations like+'fairCross' and 'fairConcatFor' nest outer and inner streams fairly,+ensuring that no stream is starved when exploring cross products.++This enables balanced exploration across all dimensions in backtracking+problems, while also supporting infinite streams without starvation. It+effectively replaces the core functionality of 'LogicT' from the+@logict@ package, with significantly better performance. In particular,+it avoids the quadratic slowdown seen with @observeMany@, and the+applicative 'fairCross' runs many times faster, achieving loop nesting+performance comparable to C.++## Arrays++Streamly provides comprehensive array functionality. Arrays are equal+partners to streams in general purpose programming.  Arrays in streamly+can be mutable or immutable, boxed or unboxed, pinned or unpinned. Thus+they unify the functionality provided by the `bytestring`, `text` and+`vector` packages. The API is integrated with streams, it is concise and+modular because all the processing is done via streams.  There is no+need of thinking about lazy bytestring vs strict bytestring, bytestring+vs text, text vs lazy text. Lazy in streamly is equivalent to stream+processing or stream of arrays, and strict is equivalent to arrays.++The `streamly-bytestring` package provides interoperation of+streamly arrays with `bytestring`. `streamly-text` package provides+interoperability with `text`.++Streamly also implements ring arrays which are essentially mutable+circular buffers. Ring Arrays help in implementing sliding windows+efficiently and conveniently.++Streamly can potentially replace most array like package for example+`array`, `primitive`, `vector`, `vector-algorithms`, `ring-buffer`,+`bytestring`.++## Serialization++Binary serialization in streamly is built into arrays. Unboxed arrays+are in fact store data in binary serialized form. The `Unbox` and+`Serialize` type classes provide fast binary serialization and+deserialization. The `MutByteArray`, `MutArray` and `Array` modules+provide functions that can serialize Haskell data types using the+`Unbox` and `Serialize` type classes.++Thus arrays in streamly are high performance alternative to+serialization packages like `binary`, `cereal`, `store` etc.++<!--+## Builders++Streams, folds, parsers and arrays are natural builders in streamly.+Folds are natural stream builders, mutable arrays are natural array+builders.++The fastest way to encode and decode Haskell data types is via+the `Unbox` and `Serialize` type classes. However, if you require+custom ways to encode or decode the Haskell data types, the fastest+way is to directly encode to or decode from `MutArray` using the+`Streamly.Internal.Data.Binary.MutArray` module (yet to be written).+Also, using `Streamly.Internal.Data.Builder` and yet to be written+serialize and deserialize monads.++Less efficiently, for custom encoding, you can build a stream+of encoded streams or possibly a stream of arrays using+the `Streamly.Internal.Data.Binary.Stream` module and then+flatten it.  For custom decoding you can build a parser using+`Streamly.Internal.Data.Binary.Parser` module.++| Package        | Streamly Type          | Combinators                              |+|----------------|------------------------|------------------------------------------|+| dlist          | Stream, Fold           | Fold.toList, Fold.addOne, Fold.addStream |+| bytestring     | Stream, Fold, MutArray |                                          |+-->++<!-- vector-builder -->++## File System++Streamly provides native, high-performance streaming APIs for file+system operations.  There is also a module for file path representation+which leverages streamly arrays for high performance and safe path+operations. Path module is designed to allow gradual typing, you can+choose to use untyped path, absolute vs relative distinction, file vs+dir distinction or all four. The typed versions are not released yet but+available as internal modules.++Paths and directory modules in streamly can be used as an alternative+for `filepath`, `directory`, and `path` packages.++## Network++Streamly provides native streaming APIs for network operations as a higher+level alternative to the `network` package functionality.++## Clock and Time++Streamly provides clock, time and timer APIs for high-performance+streaming use. See the `Streamly.Internal.Data.Time.Clock`,+`Streamly.Internal.Data.Time.Units` modules. These are currently+internal but will be released in a future release.++## Compatibility++Streamly can interwork with other packages in the Haskell ecosystem+providing similar functionality. Following is a list of examples or+packages providing interconversion:++<!-- TODO foldl interworking -->+<!-- TODO vector interworking -->++| Interop with   | Example, package                                                      |+|----------------|-----------------------------------------------------------------------|+| streaming      | [streamly-examples](https://github.com/composewell/streamly-examples) |+| pipes          | [streamly-examples](https://github.com/composewell/streamly-examples) |+| conduit        | [streamly-examples](https://github.com/composewell/streamly-examples) |+| bytestring     | [streamly-bytestring](https://github.com/psibi/streamly-bytestring)   |+| text           | [streamly-text](https://github.com/composewell/streamly-text)         |+| filepath       | [streamly-filepath](https://github.com/composewell/streamly-filepath) |++See the `streamly-ecosystem` chapter for more details.
+ docs/User/Tutorials/types-and-modules(examples).md view
@@ -0,0 +1,515 @@+# Packages and Modules++Streamly is a self sufficient, batteries included library for general+purpose programming.  It has been designed for ease of use and high+performance.++Streamly consists of two packages: "streamly-core" and "streamly".+[streamly-core](https://hackage.haskell.org/package/streamly-core)+provides most of the core functionality, and depends only on GHC boot libraries, while+[streamly](https://hackage.haskell.org/package/streamly) provides+higher-level features like concurrency, time based streaming+combinators, lifted exceptions, and streaming network operations.++Streamly is built around two core data structures: streams and+arrays. They are computational duals—streams enable dataflow-style+processing, while arrays provide efficient data storage. Together, they+form a powerful foundation for general-purpose programming in+functional and dataflow paradigms.++The general data processing functionality in `streamly` can be divided+into following categories:++* Streams: for processing of in flight data+* Arrays: for in-memory storage of data at rest+* Serialization: for on-disk storage of data at rest+* Concurrency: for scaling your applications across CPUs++The essential domain specific functionality can be divided into the+following categories:++* Console IO: reading from and writing to stdin, stdout and stderr+* File system IO: for interfacing with the file system+* Network IO: for interfacing with the network+* Unicode: stream processing of Unicode text++## Streams++In functional programming, the **stream processing paradigm** offers+a higher-level alternative to the low-level looping constructs of+imperative programming. In Streamly, the `Stream` abstraction models+data as a sequence of items of the same type. Functional operations can+then be applied to process and transform each item, producing a new+stream of either the same or a different type.++### Stream Type++The following contrived example generates a stream of integers,+increments each element by 1, takes the first two elements, adds them+together, and prints the result:++```haskell+import Data.Function ((&))+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl++main1 =+    Stream.enumerateFromTo 1 3    -- Stream IO Int+      & fmap ((+1) :: Int -> Int) -- Stream IO Int+      & Stream.take 2             -- Stream IO Int+      & Stream.fold Fold.sum      -- IO Int+      >>= print                   -- IO ()+```++See "Streamly.Data.Stream" module.++### Fold Type++Just like the `Stream` type represents a producer of a sequence of+items, the `Fold` type represents a consumer of a sequence of items of+the same type. A fold consumes a stream and returns a single value as+output. The `Fold.sum` function above is a `Fold` which consumes an+integer stream as input and returns their sum as output. The fold is+driven using the `Stream.fold` combinator.++Folds can be composed using combinators. For example, the `teeWith`+combinator combines two folds so that the input stream is fed into both+the folds simultaneously.++```haskell+f :: Monad m => Fold.Fold m Int (Int, Int)+f = Fold.teeWith (,) Fold.sum (Fold.lmap (\x -> x * x) Fold.sum)+main2 =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold f          -- IO Int+      >>= print                -- IO ()+```++See "Streamly.Data.Fold" module.++### Scanl Type++The `Scanl` type represents a stateful transformation from a stream+to another stream. As a contrived example to demonstrate the basic+functionality of scans let us compute the expression `x^4 + 3x^2 + 4` for+each number in a stream.++```haskell+scan1 :: Monad m => Scanl.Scanl m Int Int+scan1 = Scanl.mkScanl (\_ x -> x * x) undefined++scan2 :: Monad m => Scanl.Scanl m Int Int+scan2 = Scanl.mkScanl (\_ x -> 3 * x) undefined++scan3 :: Monad m => Scanl.Scanl m Int Int+scan3 = Scanl.teeWith (+) scan1 scan2 -- Compute x^2 + 3x++scan4 :: Monad m => Scanl.Scanl m Int Int+scan4 = Scanl.postscanl scan1 scan3   -- compute x^2 then pass it to scan3++main3 =+    Stream.enumerateFromTo 1 3             -- Stream IO Int+      & Stream.scanl scan4                 -- Stream IO Int+      & fmap (+4)                          -- Stream IO Int+      & Stream.fold (Fold.drainMapM print) -- IO ()+```++`scan3` splits the computation into two parts, one part computes `x^2`+using `scan1` and the other part computes `3x` using `scan2` and then it+zips the two parts back into a single stream by summing them. `scan4`+first passes an element through `scan1` thus squaring it and then it+passes the result through `scan3`, the final result is+`x^4 + 3x^2`. Then we add 4 in the resulting stream and print each+element in the stream.++In general, using scans, we can split the stream into multiple streams+and perform different stateful computations in each branch and then+merge them back into a single stream.++See "Streamly.Data.Scanl" module.++### Parser Type++The `Parser` type represents a stream consumer just like the `Fold` type+but it adds failure handling and backtracking of input on failure.++For example, to parse a sequence of digits:++```haskell docspec+>>> import Data.Function ((&))+>>> import qualified Data.Char as Char+>>> import qualified Streamly.Data.Stream.Prelude as Stream+>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Stream as Stream (parsePos)+>>> decimal = Parser.takeWhile1 Char.isDigit Fold.toList+>>> Stream.parsePos decimal $ Stream.fromList "1234 is the number"+Right "1234"+>>> Stream.parsePos decimal $ Stream.fromList "this is the number"+Left (ParseErrorPos 1 "takeWhile1: predicate failed on first element")+```++On failure we can return a default value:++```haskell docspec+>>> import Control.Applicative ((<|>))+>>> Stream.parse (decimal <|> pure "0") $ Stream.fromList "this is the number"+Right "0"+```++See "Streamly.Data.Parser" module.++## Arrays++<!-- TODO Add pinning and unpinning examples+See the+[streamly-bytestring](https://github.com/psibi/streamly-bytestring)+repository.+-->++While streams are meant for sequential processing of in-flight data, arrays+are meant for storing data in memory with serial or random access. Processing+of the data stored by arrays is done using streams.++### Immutable Arrays++The `Array` type is used to represent immutable arrays which cannot be+modified in-place.++```haskell docspec+>>> import qualified Streamly.Data.Array as Array+>>> arr = Array.fromList "hello"+>>> Array.length arr+5+>>> Array.getIndex 1 arr+Just 'e'+```++Arrays provide streaming interfaces. Like all other data in streamly, arrays+are transformed using stream transformations.++```haskell docspec+>>> arr <- Stream.fold Array.create $ Stream.enumerateFromTo 1 (5 :: Int)+>>> show arr+"fromList [1,2,3,4,5]"+>>> arr1 <- Stream.fold Array.create $ fmap (+1) $ Array.read arr+>>> show arr1+"fromList [2,3,4,5,6]"+```++See "Streamly.Data.Array" and "Streamly.Data.Array.Generic" modules.++### Mutable Arrays++The `MutArray` type is used to represent mutable arrays which can be+modified in-place.  Mutable arrays also have a reserved capacity to grow+without reallocation.++```haskell docspec+>>> import qualified Streamly.Data.MutArray as MutArray+>>> arr <- Stream.fold (MutArray.createOf 12) $ Stream.fromList "hello"+>>> arr1 <- MutArray.snoc arr ' '+>>> arr2 <- Stream.fold (MutArray.append2 arr1) $ Stream.fromList "world "+>>> MutArray.toList arr2+"hello world "+>>> MutArray.putIndex 11 arr2 '!'+>>> MutArray.toList arr2+"hello world!"+```++Since we allocated an array of 12 elements to begin with, `snoc` and+`append` operations do not reallocate the array, they just append to the+existing array.++See "Streamly.Data.MutArray" and "Streamly.Data.MutArray.Generic" modules.++## Serialization++### MutByteArray++The `MutByteArray` type is used to represent low level mutable byte+arrays which can be modified in-place. `Unbox` and `Serialize` type+classes use this data type to serialize Haskell data structures.++### Unbox++Unbox provides fast serialization of fixed size data types.+`deriveUnbox` can be used to automatically derive the instances of+`Unbox`. `Unbox` can also be derived using `Generic`.  `Unbox` type+class provides `pokeAt` and `peekAt` operations to serialize and+deserialize Haskell data types:++```haskell docspec+>>> import qualified Streamly.Data.MutByteArray as MutByteArray+>>> import Data.Proxy (Proxy(..))+>>> arr <- MutByteArray.new 10+>>> MutByteArray.pokeAt 0 arr 'h'+>>> offset = MutByteArray.sizeOf (Proxy :: Proxy Char)+>>> MutByteArray.pokeAt offset arr (1234 :: Int)+>>> r :: Char <- MutByteArray.peekAt 0 arr+>>> r+'h'+>>> r1 :: Int <- MutByteArray.peekAt offset arr+>>> r1+1234+```++The `Array` and MutArray types are unboxed arrays, they require an+`Unbox` instance. Writing to an `Array` or `MutArray` is in fact+exactly the same as serializing the type, and reading from them is+deserializing it.++### Serialize++`Serialize` provides fast serialization of any Haskell data types.+`deriveSerialize` can be used to automatically derive the instances+of `Serialize`.  `Serialize` type class provides `serializeAt` and+`deserializeAt` operations to serialize and deserialize Haskell data+types:++```haskell docspec+>>> import qualified Streamly.Data.MutByteArray as MutByteArray+>>> arr <- MutByteArray.new 10+>>> offset <- MutByteArray.serializeAt 0 arr 'h'+>>> offset1 <- MutByteArray.serializeAt offset arr (1234 :: Int)+>>> (next, r :: Char) <- MutByteArray.deserializeAt 0 arr offset1+>>> r+'h'+>>> (next1, r1 :: Int) <- MutByteArray.deserializeAt next arr offset1+>>> r1+1234+```++The Array module also provides operations to serialize and deserialize a+Haskell data type to an `Array Word8`, using the `Serialize` type class:++```haskell docspec+>>> import qualified Streamly.Data.Array as Array+>>> arr = Array.serialize' (1234 :: Int)+>>> fst (Array.deserialize arr) :: Int+1234+```++## Concurrency and Time++Concurrency and time operations can be found in the `streamly` package.+Stream operations can be performed concurrently by using the concurrent+combinators.++### Concurrent Streams++The following example uses `parMapM` which is a concurrent version of `mapM`,+consequently it prints a value every second even though there is a 2 second+serial delay for each element.++```haskell docspec+>>> import Control.Concurrent (threadDelay)+>>> let delay n = threadDelay (n * 1000000) >> return n+>>> :{+parMap =+      Stream.repeatM (delay 1)+    & Stream.parMapM (Stream.ordered True) (\x -> delay 1 >> print x)+    & Stream.fold Fold.drain+:}+```++See `Streamly.Data.Stream.Prelude` module.++### Concurrent Folds++The following example evaluates each fold in a separate thread, therefore, even+though each fold introduces a serial delay of 1 second, the total delay is+still only 1 second instead of 2 seconds.++```haskell docspec+>>> import qualified Streamly.Data.Fold.Prelude as Fold+>>> p x = delay 1 >> print x+>>> f1 = Fold.parBuffered id (Fold.drainMapM p)+>>> f2 = Fold.parBuffered id (Fold.lmap (\x -> x * x) (Fold.drainMapM p))+>>> f = Fold.teeWith (\_ _ -> pure ()) f1 f2+>>> :{+parFolds =+    Stream.enumerateFromTo 1 3 -- Stream IO Int+      & Stream.fold f          -- IO ()+:}+```++See `Streamly.Data.Fold.Prelude` module.++### Time Domain Operations++Streamly provides time domain stream operations for reactive programming+including event sampling operations like throttle and debounce.++For example, the `intervalsOf` operation collapses stream elements within a+specified time interval.++```haskell docspec+>>> input = Stream.parBuffered (Stream.constRate 2) $ Stream.enumerateFrom 1+>>> intervals = Stream.intervalsOf 1 Fold.toList input+>>> Stream.fold Fold.toList $ Stream.take 2 intervals+[[1,2],[3,4]]+```++See `Streamly.Data.Fold.Prelude` module.++## Console IO++The `Streamly.Console.Stdio` module provides facilities to read a stream+from stdin and to write a stream to stdout and stderr.++Implementation of a console echo program:++```haskell unshared+import Data.Function ((&))+import qualified Streamly.Console.Stdio as Stdio++main =+  Stdio.readChunks    -- Stream IO (Array Word8)+    & Stdio.putChunks -- IO ()+```++An example to read two numbers from separate lines on stdin and sum them:++```haskell unshared+import Data.Function ((&))+import qualified Streamly.Internal.Console.Stdio as Stdio+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main =+    Stdio.readChars                              -- Stream IO Char+      & Stream.splitSepBy_ (== '\n') Fold.toList -- Stream IO String+      & fmap read                                -- Stream IO Int+      & Stream.take 2                            -- Stream IO Int+      & Stream.fold Fold.sum                     -- IO Int+      >>= print                                  -- IO ()+```++## File IO++Implementation of the Unix `cp` utility to copy `input.txt` to `output.txt`:++```haskell unshared+{-# LANGUAGE QuasiQuotes #-}++import Data.Function ((&))+import Streamly.FileSystem.Path (path)+import qualified Streamly.FileSystem.FileIO as File+import qualified Streamly.FileSystem.Path as Path+import qualified Streamly.Data.Stream as Stream++main =+  File.readChunks [path|input.txt|]                     -- Stream IO (Array Word8)+    & Stream.fold (File.writeChunks [path|output.txt|]) -- IO ()++```++Implementation of the Unix `cat` utility to read all files from+the current directory on standard output.++```haskell unshared+{-# LANGUAGE QuasiQuotes #-}++import Data.Function ((&))+import Streamly.FileSystem.Path (path)+import qualified Streamly.FileSystem.DirIO as Dir+import qualified Streamly.FileSystem.Path as Path+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Console.Stdio as Console+import qualified Streamly.FileSystem.FileIO as File++main =+  Dir.read [path|.|]                   -- Stream IO Path+    & Stream.concatMap File.readChunks -- Stream IO (Array Word8)+    & Console.putChunks                -- IO ()+```++## Network IO++Streaming network operations can be found in `Streamly.Network.*` modules. Here+is a streaming implementation of a concurrent network server which echo's back+whatever it receives.++```haskell docspec+>>> import Control.Exception (finally)+>>> import Network.Socket (Socket)+>>> import qualified Network.Socket as Net+>>> import qualified Streamly.Network.Inet.TCP as TCP+>>> import qualified Streamly.Network.Socket as Socket+>>> :{+main :: IO ()+main =+      TCP.accept 8091                            -- Stream IO Socket+    & Stream.parMapM id (handleExceptions echo)  -- Stream IO ()+    & Stream.fold Fold.drain                     -- IO ()+    where+    echo :: Socket -> IO ()+    echo sk =+          Socket.readChunksWith 32768 sk      -- Stream IO (Array Word8)+        & Stream.fold (Socket.writeChunks sk) -- IO ()+    handleExceptions :: (Socket -> IO ()) -> Socket -> IO ()+    handleExceptions f sk = finally (f sk) (Net.close sk)+:}+```++## Unicode Operations++The `Streamly.Unicode.*` modules provide stream operations like UTF-8, UTF-16+encoding and decoding, splitting Unicode char streams into lines, words and+joining lines and words etc.++String quasiquoter:++```haskell docspec+>>> :set -XQuasiQuotes+>>> import Streamly.Unicode.String (str)+>>> [str|this is a string|]+"this is a string"+```++String interpolation:++```haskell docspec+>>> x = "interpolated"+>>> [str|this is an #{x} string|]+"this is an interpolated string"+```++Splitting a string into lines, each line is collected in a list fold and+all the lines are collected in a list fold.:++```haskell docspec+>>> import qualified Streamly.Internal.Unicode.Stream as Unicode+>>> Stream.fold Fold.toList $ Unicode.lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")+["lines","this","string","",""]+```++You could supply any fold to consume the lines in a different way, for example+use `Fold.length` to print the lengths of the lines:++```haskell docspec+>>> Stream.fold Fold.toList $ Unicode.lines Fold.length (Stream.fromList "lines\nthis\nstring\n\n\n")+[5,4,6,0,0]+```++Decoding the contents of a file into a stream of Unicode chars:++```haskell docspec+>>> import Streamly.FileSystem.FileIO as File+>>> import Streamly.FileSystem.Path as Path+>>> :{+countChars inpFilePath = do+   inp <- Path.fromString inpFilePath+   File.readChunks inp & Unicode.decodeUtf8Chunks & Stream.fold Fold.length+:}+```++Streamly.Unicode.Parser provides Unicode char and sequence parsers:++```haskell docspec+>>> import qualified Streamly.Unicode.Parser as Unicode+>>> Stream.parse Unicode.double $ Stream.fromList "3.14"+Right 3.14+```
+ docs/User/Tutorials/types-and-modules(summary).md view
@@ -0,0 +1,102 @@+# Streamly: Types & Modules Cheat Sheet++This guide gives you a quick overview of Streamly’s core modules,+types, and their typical use cases. Use it as a reference map when+navigating the library.++## streamly-core package++![Streamly Core Modules](./streamly-core.svg)++## streamly package++![Streamly Modules](./streamly.svg)++## Streams++### Sources+- `Stream m a` — statically fused, composable source streams<br>+  **Module:** `Streamly.Data.Stream`+- `Unfold m a b` — statically fused streams, for nested fusion<br>+  **Module:** `Streamly.Data.Unfold`+- `StreamK m a` — CPS based source streams for dynamic composition<br>+  **Module:** `Streamly.Data.StreamK`++### Transformations++- `Scanl m a b` — statically fused scans, for composable stateful transformation<br>+  **Module:** `Streamly.Data.Scanl`++### Consumers++- `Fold m a b` — statically fused, composable stream consumers<br>+  **Module:** `Streamly.Data.Fold`+- `Parser a m b` — statically fused, composable parsers<br>+  **Module:** `Streamly.Data.Parser`+- `ParserK a m b` — CPS based parsers for dynamic composition<br>+  **Module:** `Streamly.Data.ParserK`++---++## Arrays++### Immutable++- `Array a => Unbox a` — immutable, unboxed (pinned/unpinned)<br>+  **Module:** `Streamly.Data.Array`+- `Array a` — unconstrained type<br>+  **Module:** `Streamly.Data.Array.Generic`++### Mutable++- `MutArray a => Unbox a` — mutable, unboxed (pinned/unpinned)<br>+  **Module:** `Streamly.Data.MutArray`+- `MutArray a` — unconstrained type<br>+  **Module:** `Streamly.Data.MutArray.Generic`+- `RingArray a => Unbox a` — unboxed, circular buffer (pinned/unpinned)<br>+  **Module:** `Streamly.Data.RingArray`++### Serialization++- `Unbox a` — type class for fixed length binary serialization<br>+  **Module:** `Streamly.Data.MutByteArray`+- `Serialize a` — type class for variable length binary serialization<br>+  **Module:** `Streamly.Data.MutByteArray`+- `MutByteArray` — raw mutable byte arrays<br>+  **Module:** `Streamly.Data.MutByteArray`++---++## Unicode Operations++- `Streamly.Unicode.Stream` — encode/decode streams of text+- `Streamly.Unicode.Parser` — parsers for Unicode chars/strings+- `Streamly.Unicode.String` — string interpolation utilities++---++## Concurrent Operations++High-level concurrent, time-based, and lifted operations.++- `Streamly.Data.Stream.Prelude` — concurrent operations for `Stream` type+- `Streamly.Data.Scanl.Prelude` — concurrent operations for `Scanl` type+- `Streamly.Data.Fold.Prelude` — concurrent operations for `Fold` type+- `Streamly.Data.Stream.MkType` — define custom monad/applicative stream types  ++---++## File System++- `Streamly.Console.Stdio` — console (stdin/stdout/stderr) streams+- `Streamly.FileSystem.Handle` — handle-based I/O streams+- `Streamly.FileSystem.FileIO` — path-based file I/O streams+- `Streamly.FileSystem.DirIO` — directory read streams+- `Streamly.FileSystem.Path` — file path operations++---++## Network++- `Streamly.Network.Socket` — socket-level stream operations+- `Streamly.Network.Inet.TCP` — TCP accept streams/connect
+ docs/User/Tutorials/using-streamly.md view
@@ -0,0 +1,268 @@+<!--+(c) 2019, Composewell Technologies.+Portions (c) 2020, Google LLC.+SPDX-License-Identifer: BSD-3-Clause+-->++# Getting started with `Haskell Streamly`++This guide shows you how to use Streamly in the GHCi REPL, in a simple+program, or in a Haskell project.++<!-- TODO: Add instructions for `stack` and `nix`.++If you are using `stack` or `nix` please make sure to add the latest+version from Hackage to your tool configuration.  -->++No prior knowledge of Haskell is needed.  We do however assume that you+are using a command-line shell on a POSIX operating system.  If you are+running Windows&trade; then you may need to run a command-line shell+under `msys` and some of the commands below may also need to be changed+in small ways to make them work.++## Streamly Library Packages++Streamly comprises two packages, the+[streamly-core](https://hackage.haskell.org/package/streamly-core)+package provides functionality that depends only on boot libraries, and+the [streamly](https://hackage.haskell.org/package/streamly) package+provides additional functionality like concurrency, time, lifted+exceptions, and networking.++For high-level functionality built over streamly like streaming+system processes, shell programming, GNU coreutils, statistics,+and compression libraries please see the [streamly ecosystem+packages](https://streamly.composewell.com/module-listing.html).++## Released and Pre-release modules++Some of the examples in the tutorials may use modules from the+`Internal` Streamly module hierarchy.  These modules are not really+internal to the library.  We classify `Streamly` modules into two+categories:++* _Released modules and APIs_: These modules and APIs are+  stable. Significant changes to these modules and APIs will cause+  Streamly's version number to change according to the package versioning+  policy.+* _Pre-release modules and APIs_: These modules and APIs have not been+  formally released yet.  They may change in the near future, and such+  changes will not necessarily be reflected in Streamly's package+  version number.  As yet unreleased modules and APIs reside in the+  `Internal` namespace.++Please use a minor release upper bound to adhere to the Haskell PVP when+using a pre-release (internal) module.++<!--+Link References.+-->++## Using `streamly` Interactively in REPL++You can try out `streamly` using `GHCi`, the interactive Haskell+read-eval-print-loop (REPL).++Streamly consists of two packages, namely `streamly-core` and+`streamly`. The former package provides basic functionality and the+latter provides higher level functionality. To start up the GHCi REPL+using the latest released `streamly-core` package from Hackage, please+use:++```+$ cabal repl --build-depends streamly-core+... plenty of build messages, the first time around ...+GHCi, version 9.2.2: https://www.haskell.org/ghc/  :? for help+ghci>+```++This command may take a while to build the package first time around,+please be patient.++Once at the `ghci>` prompt, you can import Haskell modules from the+`streamly-core` package and use the available functions in the REPL:++```+ghci> import qualified Streamly.Data.Stream as Stream+ghci> import qualified Streamly.Data.Fold as Fold++ghci> Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]+1+2+3+ghci>+```++For the curious, here is a high level overview of what these lines+do:++1. `import qualified Streamly.Data.Stream as Stream` imports the Streamly+   Stream module into GHCi, and makes it available under the name `Stream`.+2. `[1..3]` generates the Haskell list `[1, 2, 3]`.+3. `Stream.fromList` transforms that list into a stream of integers.+4. `Stream.mapM print` transforms the stream of integers into a stream of+   actions that would print those integers when executed.+5. `Stream.fold Fold.drain` folds that stream using the `drain` fold,+   transforming it into an IO action that evaluates the stream.++### Using a specific version of `streamly` in the REPL++You can also ask `cabal` to use a specific version of `streamly-core` by+adding a version number constraint to the `--build-depends` flag:++```+$ cabal repl --build-depends streamly-core==0.1.0+...+ghci>+```++## Using `streamly` in a Project++Create a project directory for our example project.++```+$ mkdir streamly-project+```++### Add `streamly` as project dependency++Run `cabal init` in the project directory to create an initial set of+project files:++```+$ cd streamly-project+$ cabal init --non-interactive --minimal --dependency base --dependency streamly-core++...+Generating app/Main.hs...+Generating streamly-project.cabal...+...+```++This invocation sets up a Haskell package named `streamly-project`+with two build dependencies, namely `base` (the Haskell standard+library) and `streamly-core`.  You can add additional dependencies+later, by editing the `build-depends` section of the generated+cabal file `streamly-project.cabal`.  Please see the [Cabal User+Guide](https://www.haskell.org/cabal/users-guide/) for more information+on `.cabal` files.++IMPORTANT: Because of a bug in cabal 3.8, which is fixed in cabal 3.10,+this does not generate a dependency on `base`, please edit the generated+cabal file and add `base` in the `build-depends` section:++```+    build-depends: base, streamly-core+```++This invocation also creates a skeletal `app/Main.hs`, therefore, we can+compile and run it right away:++```+$ cabal run+Hello, Haskell!+```++### Import `streamly` modules in the project code++Let us now turn the single-line stanza we used in the REPL into a+standalone program.++Edit `app/Main.hs` to contain the following:++```haskell+module Main where++import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main :: IO ()+main = Stream.fold Fold.drain $ Stream.mapM print $ Stream.fromList [1..3]+```++Build and run this program using `cabal run`:++```+$ cabal run+... build messages ...+1+2+3+```++### Running GHCi REPL for the project code++To start up the GHCi REPL for your project, please use:++```+$ cabal repl+...+Ok, one module loaded.+ghci> main+1+2+3+ghci>+```++The repl will load all the dependencies and modules of the project. You can now+run your project code or any other code snippets as you desire.++### (Advanced) Using the development version of `streamly`++To use the development version of `streamly`, we need to configure+`cabal` to fetch it from Github.++Create a `cabal.project` file in the project directory with the+following content:++```+packages: .+-- fetch streamly-core dependency package from github+source-repository-package+  type: git+  location: https://github.com/composewell/streamly+  subdir: core+  tag: master+```++With this file present, `cabal` will fetch and build the current+version of `streamly-core` from Github.  For example:++```+$ cabal repl+Cloning into '/home/harendra/streamly-project/...+...+In order, the following will be built (use -v for more details):+ - streamly-core-0.1.0 (lib:streamly-core) (requires build)+ - streamly-project-0.1.0.0 (exe:streamly-project) (configuration changed)+ ...+ghci>+```++## Which version of `streamly` should you use?++If you are new to Streamly, we recommend using the latest [stable release+of streamly][streamly-hackage] on Hackage.++If you need access to cutting edge features (and do not mind the+occasional breakage), please use the [development version of+streamly][streamly-github] from Github.++## Building for Performance++If you wish to run benchmarks, please be sure to build your+application using the instructions in the [Build Guide](/docs/User/HowTo/Compiling.md).++## Next Steps++If you got this far successfully, congratulations!  For an overview+of the `streamly` package, please read the [Learn By+Examples](/docs/User/Tutorials/learn-by-examples.md) page.++<!-- Markdown Links -->++ [Streamly]: https://streamly.composewell.com/+ [streamly-hackage]: https://hackage.haskell.org/package/streamly+ [streamly-github]: https://github.com/composewell/streamly+ [streamly-packages]: https://github.com/composewell/streamly-packages
docs/User/Tutorials/why-haskell-streamly.md view
@@ -3,89 +3,150 @@ SPDX-License-Identifer: BSD-3-Clause --> -# Why Haskell Streamly?+# Why Haskell and Streamly? -A computer programmer is faced with different types of programming tasks. A-software project may involve programming tasks that have different-characteristics. Usually programmers are forced to choose different programming-tools for different tasks.+## Why Haskell? -For example, you may be writing shell or python scripts to automate system-administration or deployment tasks, or for managing cloud deployments,-configuration. For such tasks you may not be worried about the performance but-you may be worried about correctness and how quickly you can achieve what you-want to do, and maintainability of the programs. For such tasks you would-usually reach out for python, shell scripting or other such high level-scripting languages.+Haskell provides a rock-solid foundation for building reliable,+maintainable, and efficient systems. It combines the rigor of a strongly+typed, purely functional language with the practicality of modern+tooling. -On the other hand you may be writing a program that require very high-performance and optimal use of resources so that the task can be finished-faster and requires less resources to save cost. High level scripting languages-(e.g. python or shell) may be unsuitable for such tasks because they could be-10x-100x slower compared to lower level languages like `Rust`, `C`, `C++` or-`Java`.+### Interactive Development (GHCi) -If you would like to use the same language and tools for all your-programming tasks, be it a quick script or a high performance system,-or if you do not want to build different set of teams for programming-tasks of different nature then Haskell Streamly is just the programming-framework for you.+Haskell is compiled for performance, but it also ships with an+interpreter (GHCi). This gives you the convenience of interactive+exploration—like Python or Ruby—while still compiling to fast native+code when needed. Types are inferred automatically, so you often don’t+need to write them explicitly, but they are always there to guarantee+safety. -Whether you are writing scripts to manage your systems, or to automate mundane-tasks like organizing photos or files on your computer, or to write tests for-your software systems, or crawling the network to glean some information, or-writing a quick network server, or writing algorithmic trading systems, or-doing high performance intensive data processing, Haskell Streamly is just the-right tool for you.+### Fearless Refactoring -Haskell Streamly is a very high level programming framework, like Python or-Shell or Sed or AWK, in fact much higher level than those, but at the same time-provides high performance like C or Rust. The ability to compose programs using-high level combinators in Haskell is unmatched. Not just efficient programs but-you can write programs that scale on multiple CPUs with the same ease. Streamly-uses the full power of Haskell to make concurrency composable in declarative-style, so that you can use concurrent programming fearlessly with the same ease-as non-concurrent programming.+Large systems inevitably evolve, and in many languages refactoring+introduces new bugs. In Haskell, immutability and a strong static type+system keep programs consistent, while the compiler catches errors early.+This makes refactoring safe and reliable—a quality that experienced+Haskell developers consistently vouch for in production systems. -Although Haskell is a compiled programming language it comes with an-interpreter (GHCi) which allows you to run Haskell code interactively like an-interpreted language. Haskell has a strong static type system, yet in most-cases you do not have to annotate the types because it infers the types-automatically.+### Correctness by Design -You can keep systems written with Haskell Streamly extremely modular using-reusable building blocks, modularity is the fundamental characteristic and-a design goal of Streamly. At the same time Haskell allows you to do fearless-refactoring of your program to continuously evolve it without the fear of-introducing more bugs or breaking it every time you touch it.+Many common bugs in other languages—null pointer exceptions, data+races, accidental mutation—simply don’t exist in Haskell. This frees+you to focus on business logic instead of defensive programming. -The type safety and immutability by default in Haskell avoids a lot of bugs-that would otherwise find their way into your programs if you are using less-safe languages. You focus on your business logic rather than the correctness-issues imposed by the programming paradigm.+### Portability and Interoperability -Haskell is extensible, you can integrate C programs with Haskell very easily.-Programs written in Haskell work on `macOS`, `Windows`, `Linux` or any Unix-like system and even on the browser using the Java Script and Web assembly-backends.+Haskell is portable across Linux, macOS, Windows, and even the browser+(via JavaScript or WebAssembly). It can seamlessly interoperate with C,+Python, and many other languages, letting you reuse existing code and+libraries. -Haskell Streamly is a standard library for Haskell and supplements the Haskell-base package. It comes equipped with basic data structures and functions like-Streams, Arrays, Folds, Parsers, file system facilities like directory IO, file-IO, Unicode text processing, network processing using low level sockets or high-level operations. Concurrent programming facilities or time domain programming-facilities.+--- -The collection of high level building blocks provided by the Streamly ecosystem-allow you to write a variety of programs quickly. You can turn your shell or-python scripts into safe, highly modular and high performance programs using-`streamly-coreutils`. Moreover, you do not have to depend on any native OS-packages installed on the system. Or if you would like to use native-executables in your programs you can use `streamly-process` to invoke the-executables and connect the data streams generated like pipes in a seamless-manner. Or if you would like to use the shell to invoke and compose the-executables and integrate it seamless in your program you can do that too using-`streamly-shell`. If you would like to use statistical computation in your-programs try out `streamly-statistics`. Streamly ecosystem is evolving and-there are more useful packages in the works. In addition, you have thousands of-Haskell packages that are available on Hackage.+## Why Streamly?++Streamly builds on Haskell’s strengths to provide a single framework+for everything from quick automation scripts to high-performance+servers. It combines **Python’s ease of use, C’s performance,+Rust’s safety, and Go’s concurrency model**—all in one framework,+and goes even further.++### Performance Matching Low-Level Languages++High-level scripting languages like Python or Bash can be **10x–100x+slower** than optimized low-level languages such as C, Rust, or+Java. For tasks where efficiency matters—data pipelines, servers,+or numerical processing—this overhead is unacceptable.++Streamly leverages GHC’s advanced optimizations and stream fusion to+deliver performance on par with C, without sacrificing expressiveness.+It gives you the best of both worlds: the productivity of high-level+scripting languages like Python or Bash, with the performance of+low-level languages like C and Rust.++### More Expressive than Scripting Languages++For scripting, system management, data wrangling, or even spinning up+quick servers, Streamly offers high-level combinators that let you+compose programs declaratively. Its design philosophy emphasizes+**modularity**: a hierarchy of composable building blocks, where+higher-level constructs are built from lower-level ones. This degree+of modularity is possible in Haskell due to purity, which enables+the compiler to reason about and combine components safely, creating+higher-level functionality without compromising performance. The result+is much more power and expressiveness than Python or shell scripting—+while still compiling to efficient native code.++### Fearless Concurrency++Streamly is designed for concurrency, allowing you to write concurrent+code in a declarative style. Haskell’s purity lends itself+particularly well to concurrency, and Streamly leverages this unique+feature in Haskell. Its high-level abstractions free you from low-level+concerns such as threads, locks, and synchronization. There is little+distinction between concurrent and non-concurrent code—if your program+follows the streaming paradigm, it can be made concurrent effortlessly.++### Standard Library for Real-World Needs++The streaming model is the truest form of functional programming,+delivering the high composability that functional programming promises.+Streamly extends Haskell’s base library with unified, streaming-capable+APIs for everyday programming:++- Streams, folds, and parsers for data processing+- Arrays for random-access storage with streaming APIs+- Binary serialization and deserialization+- Streaming file and directory I/O+- Streaming Unicode text processing+- Streaming network APIs+- Time-based streaming APIs for FRP+- Concurrency built into all APIs++With these tools, you can move seamlessly from quick prototypes to+production-grade systems—without ever switching languages.++### Streamly Ecosystem++Beyond the core library, Streamly provides an ecosystem of packages:++- **`streamly-process`**: Launch and compose executables, connect their+  input and output streams, run shell commands, and integrate them+  seamlessly into Haskell streaming pipelines.+- **`streamly-coreutils`**: Replace shell or Python scripts with safe,+  modular, high-performance Haskell equivalents.+- **`streamly-statistics`**: Perform incremental statistical analysis on+  sliding windows of data within streaming pipelines.+- **`streamly-fsevents`**: Watch files or directories for file system+  events (inotify) and generate event streams.++More packages are continually evolving. Combined with the thousands of+Haskell libraries on [Hackage](https://hackage.haskell.org), Streamly+gives you a complete toolkit for building powerful applications.++---++## One Language for Everything++Modern software projects demand many different kinds of programs:  ++- Quick scripts for automation  +- High-performance data processing  +- Concurrent or parallel applications  +- Network servers and distributed systems  ++Traditionally, this forces programmers to juggle different tools: Python+or shell for scripting, C/C++/Rust for performance, Java/Go for servers,+and special frameworks for concurrency. This fragmentation leads to+duplicated effort, larger teams, and higher maintenance costs.++**Haskell Streamly provides a single framework for all of these+tasks.** You can write concise, high-level programs that are safe,+scalable, and easy to reason about—yet still achieve performance+competitive with C.++Haskell gives you correctness, safety, and interactive development.+Streamly adds performance, concurrency, modularity, and practical+libraries. Together, they remove the need to juggle multiple languages+for different tasks.
+ docs/User/Tutorials/why-not-lists.md view
@@ -0,0 +1,224 @@+<!--+(c) 2022, Composewell Technologies.+SPDX-License-Identifer: BSD-3-Clause+-->++# Why not lists?++This document explains some problems that you might face when using+Haskell lists and why using streams is better in those cases.++## Haskell Lazy Evaluation++Haskell is fundamentally different from other languages. In most+languages, a variable name refers to some concrete data in memory;  in+Haskell, a variable may refer to concrete data or it could refer to+a computation or expression which when evaluated would produce the+concrete data that the variable is referring to. When the value of the+variable is needed, the computation is evaluated and replaced by+the result.++When a Haskell program starts, the entire program is an unevaluated+expression which is evaluated on-demand as needed. The top level+expression is forced to produce data when a result is demanded from it+for IO.  Parts of the expression are reduced as needed, the reduction+process can be controlled by the programmer.++## Unevaluated Expressions++When we assign a value to a name, the name refers to the unevaluated+expression and not what it would produce when evaluated. For example:++```+>>> infiniteList = [1..]+```++The name `infiniteList` refers to an expression which when evaluated+would generate the list. `infiniteList` is not an actual physical list+but just an expression to generate the list `when needed`. Because we+are not storing the actual list in memory, we can represent an infinite+list without requiring infinite amount of memory.++Let's try to get the length of this list:++```+>>> len = length infiniteList+```++Like before, the name `len` refers to an expression that when evaluated+would give us the length of the list.  Till now Haskell has been saying+that I duly noted how to do what you want to do but I will do it only+when you need it. Let's ask it to do that now:++```+>>> len+...hangs forever+```++Now, Haskell has no choice but to start evaluating the expression but we+know it can never finish because the list is infinite.++All expressions in Haskell are unevaluated by default.  Haskell+evaluates the expressions only when it is absolutely required e.g. when+we have to print something, or write it to a file or to network.++## On-demand Expression Evaluation++Let us illustrate expression evaluation in Haskell with an example. Write+this little program in a file `example.hs`:++```haskell unshared+main =+    let largeList = [1..1000000::Int]+        n = length largeList+     in print n+```++The expression `largeList` is never evaluated to generate the entire+list at once. It is evaluated on-demand one element at a time by the+`length` function. The `length` function is in turn evaluated by the+`print` function when it evaluates its argument `n`. The `print`+function is evaluated by the top level program because it wants to print+`n` to the console.++We can verify that the whole list is not stored in memory by looking at+the memory usage of this program. Let's compile and run it:++```+$ ghc -O example.hs+$ ./example +RTS -s+1000000+          51,480 bytes allocated in the heap+              24 bytes copied during GC+          44,328 bytes maximum residency (1 sample(s))+```++`largeList` is an expression representing a million element list, but+the program takes only 44K maximum memory.  The `length` function+evaluates `largeList` one element at a time to count them, as soon as+an element is counted it can be garbage collected as there are no more+references to it in the entire program.++## Expressions Holding up Heap Memory++Let's try this program instead:++```haskell unshared+{-# OPTIONS_GHC -Wno-x-partial #-}++main = do+    let largeList = [1..1000000::Int]+        x1 = last largeList+        x2 = head largeList+     in print (x1, x2)+```++```+$ ghc -O example.hs+$ ./example +RTS -s+(1000000,1)+      64,051,552 bytes allocated in the heap+             400 bytes copied during GC+      26,233,360 bytes maximum residency (4 sample(s))+```++This program is showing 26MB maximum residency instead of 44K+earlier. Why is it so? To evaluate the first element of the tuple, `x1`,+we need to evaluate the entire list to get to the last element. However,+the head of the list is referenced by the element `x2` as well which+is yet to be evaluated and used. Therefore, we need to retain the head+until `x2` is printed and freed. But head of the list is referencing the+next element in the list which in turn is referring to the next element+and so on, therefore, the entire list is retained in memory between the+evaluation of `x1` and `x2`.++If we change the print statement to `(x2, x1)` then we do not need to+retain the entire list between the two evaluations.++When memory is unexpectedly retained in a program it is known as a+"space-leak" in the Haskell parlance.++## Forcing Expression Evaluation++Even if there is no explicit dependency in the program forcing+evaluation of an expression, the programmer can force the evaluation of+an expression using `seq`:++```haskell unshared+{-# OPTIONS_GHC -Wno-x-partial #-}++main = do+    let largeList = [1..1000000::Int]+        x1 = last largeList+        x2 = head largeList+     in print (x1 `seq` x2)+```++Similar to the example in previous section, this example also retains+the entire list in memory because `seq` forces `x1` to be evaluated+before `x2` and then returns `x2`, the evaluated list is held until `x2` is+returned.++## Avoiding Unnecessary Memory Retention++Memory retention can be avoided by changing the way we construct the+expression to process the data. We can use Streamly to avoid memory+retention in the above program.++Let's first write it using streamly and reproduce the same problem:++```haskell unshared+import Data.Functor.Identity (runIdentity)+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main = do+    let largeList = Stream.fromList [1..1000000::Int]+        x1 = runIdentity $ Stream.fold Fold.latest largeList+        x2 = runIdentity $ Stream.fold Fold.one largeList+     in print (x1, x2)+```++This program has the same behavior as the list based program, and for+the same reasons.++```+$ ghc -O2 example.hs+$ ./example +RTS -s+(Just 1000000,Just 1)+      64,052,520 bytes allocated in the heap+             400 bytes copied during GC+      26,233,360 bytes maximum residency (4 sample(s))+```++However, we can compose the two folds using the `teeWith` combinator+such that we distribute a each element of the list to both the folds+simultaneously, thus avoiding the retainment of the entire list:++```haskell unshared+import Data.Functor.Identity (runIdentity)+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++main = do+    let largeList = Stream.fromList [1..1000000::Int]+        x = Fold.teeWith (,) Fold.latest Fold.one+     in print $ runIdentity $ Stream.fold x largeList+```++```+$ ghc -O2 example.hs+$ ./example +RTS -s+(Just 1000000,Just 1)+      64,052,736 bytes allocated in the heap+             280 bytes copied during GC+          44,328 bytes maximum residency (2 sample(s))+```++This program uses constant small memory footprint (44K) irrespective of+the order of the elements in the tuple. When an element is generated by+the list it is supplied to both the folds before generating the next+element, therefore, it can be immediately freed.++Streamly covers all the functionality of standard Haskell lists but in addition+provides powerful composition tools for better efficiency.
+ docs/diagrams/module-diagram.hs view
@@ -0,0 +1,169 @@+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE TypeFamilies              #-}++import Diagrams.Prelude+import Diagrams.Backend.SVG.CmdLine+import Data.List (isPrefixOf)++splitOn :: Eq a => [a] -> [a] -> [[a]]+splitOn delim str = go str+  where+    go [] = [[]]+    go s+      | delim `isPrefixOf` s = [] : go (drop (length delim) s)+      | otherwise =+          let (c:cs) = s+              (x:xs) = go cs+          in (c:x) : xs++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++title1 t =+  vsep 0.3 [ text line # fontSizeL 0.3 # bold | line <- splitOn "\n" t ]+title2 t = text t # fontSizeL 0.2 # bold++textBox x y t = t <> strutX x <> strutY y++item1 t = text t # fontSizeL 0.25+enumerate items = vsep 0.3 [ textBox 2.0 0.4 (item1 i) | i <- items ]++boxedXY :: Double -> Double -> Diagram B -> Diagram B+boxedXY w h content = content # centerXY  <> rect w h # lw thin++boxedEnum x y items =+    let list = enumerate items+    in boxedXY x y (list # centerXY)++titleW = 2.0+titleH = 0.5++boxedTitledEnum1 x y title items =+    let ttext = textBox titleW titleH (title1 title)+        list = enumerate items+    in boxedXY x y (vsep 0 [ttext, boxedXY x (y - titleH) (list # centerXY)])++connect1 = connectOutside' (with & arrowHead .~ tri & headLength .~ global 0.2)++coreOval :: String -> Diagram B+coreOval tag =+    textBox 2.0 0.5 (title1 tag # centerXY)+    <> ellipseXY 1.5 0.75 # fc lightblue # lw medium++-------------------------------------------------------------------------------+-- streamly-core diagram+-------------------------------------------------------------------------------++bigBoxW = 12+bigBoxH = 4+centerBoxW = bigBoxH+centerBoxH = bigBoxH++box1 = boxedXY bigBoxW bigBoxH+box2 = boxedXY centerBoxW centerBoxH++bigBoxSubContent = boxedTitledEnum1 (bigBoxW / 3) (bigBoxH - titleH)++streamsBox :: Diagram B+streamsBox =+    let prod    = bigBoxSubContent "Generation" ["Stream", "StreamK", "Unfold"]+        transf  = bigBoxSubContent "Transformation" ["Scanl"]+        cons    = bigBoxSubContent "Consumption" ["Fold", "Parser", "ParserK"]+        row     = hsep 0 [prod, transf, cons]+        title   = textBox titleW titleH (title1 "Streams")+        content = vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++arraysBox :: Diagram B+arraysBox =+    let immut  = bigBoxSubContent "Immutable" ["Array", "Array.Generic"]+        mut    = bigBoxSubContent "Mutable" ["MutArray", "MutArray.Generic", "RingArray"]+        ser    = bigBoxSubContent "Serialization" ["MutByteArray", "Unbox", "Serialize"]+        row    = hsep 0 [immut, mut, ser]+        title  = textBox titleW titleH (title1 "Arrays")+        content= vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++fileSystemBox :: Diagram B+fileSystemBox =+    let items = ["Console.Stdio", "FileIO", "DirIO", "Handle", "Path"]+        content = boxedTitledEnum1 centerBoxW centerBoxH "File System" items+    in box2 (content # centerXY)++otherModulesBox :: Diagram B+otherModulesBox =+    let unicode = boxedTitledEnum1 centerBoxW (centerBoxH * 2/3) "Unicode" ["Parser", "Stream", "String"]+        resmgmt = boxedTitledEnum1 centerBoxW (centerBoxH * 1/3) "Resource Management" ["Control.Exception"]+        content = vsep 0 [unicode, resmgmt]+    in box2 (content # centerXY)++streamlyCore :: Diagram B+streamlyCore =+    let center    = coreOval "streamly-core\n(types and modules)" # named "core"+        topBox    = streamsBox # named "streams"+        bottomBox = arraysBox # named "arrays"+        leftBox   = fileSystemBox # named "fs"+        rightBox  = otherModulesBox # named "others"++        placed = position+          [ (p2 (0,0), center)+          , (p2 (0,4), topBox)+          , (p2 (0,-4), bottomBox)+          , (p2 (-4,0), leftBox)+          , (p2 (4,0), rightBox)+          ]++        arrows = applyAll+          [ connect1 "core" "streams"+          , connect1 "core" "arrays"+          , connect1 "core" "fs"+          , connect1 "core" "others"+          ]+    in arrows placed++-------------------------------------------------------------------------------+-- streamly diagram+-------------------------------------------------------------------------------++concurrentStreamsBox :: Diagram B+concurrentStreamsBox =+    let prod    = bigBoxSubContent "Generation" ["Stream.Prelude"]+        transf  = bigBoxSubContent "Transformation" ["Scanl.Prelude"]+        cons    = bigBoxSubContent "Consumption" ["Fold.Prelude"]+        row     = hsep 0 [prod, transf, cons]+        title   = textBox titleW titleH (title1 "Concurrent Streams")+        content = vsep 0 [title, row # centerXY]+    in box1 (content # centerXY)++networkBox :: Diagram B+networkBox =+    let items = ["Network.Socket", "Network.Inet.TCP"]+        content = boxedTitledEnum1 centerBoxW centerBoxH "Network" items+    in box2 (content # centerXY)++streamly :: Diagram B+streamly =+    let center    = coreOval "streamly" # named "streamly"+        topBox    = concurrentStreamsBox # named "concurrent-streams"+        bottomBox = networkBox # named "network"++        placed = position+          [ (p2 (0,0), center)+          , (p2 (0,4), topBox)+          , (p2 (0,-4), bottomBox)+          ]++        arrows = applyAll+          [ connect1 "streamly" "concurrent-streams"+          , connect1 "streamly" "network"+          ]+    in arrows placed++main :: IO ()+main =+    mainWith+        [ ("streamly-core", (streamlyCore # centerXY # pad 1.1))+        , ("streamly", (streamly # centerXY # pad 1.1))+        ]
− docs/streamly-docs.cabal 
@@ -1,49 +0,0 @@-cabal-version:      2.2--- Reasons for having a separate package for docs:--- * Leaner main package and better modularity--- * This package can be forked out as an independent package--- * We can have code examples in haddock with more dependencies--- * Documentation can be released independent of the library--- * We do not want too many doc modules in the main library-name:               streamly-docs-version:            0.10.0-synopsis:           Documentation for Streamly-description:        Documentation for Streamly-build-type:         Simple------------------------------------------------------------------------------------ Library----------------------------------------------------------------------------------extra-doc-files:-  *.md-  User/*.md-  User/Tutorials/*.md-  User/Tutorials/*.link-  User/HowTo/*.md-  User/HowTo/*.link-  User/Explanatory/*.md-  User/Explanatory/streaming-pradigms.rst-  User/Project/*.md-  User/Project/*.link-  User/Project/ApiChangelogs/0.8.3.txt-  User/Project/ApiChangelogs/0.8.3-0.9.0.txt-  Developer/*.png-  Developer/*.md-  Developer/*.link-  Developer/*.rst--library-  default-language: Haskell2010-  ghc-options:      -Wall-  hs-source-dirs:    .-  exposed-modules:-    User.Tutorials.Tutorial-    User.Tutorials.ConcurrentStreams-    User.Tutorials.ReactiveProgramming--  build-depends:-      base              >= 4.9   &&  < 4.20-    , transformers      >= 0.4   && < 0.7-    , streamly-    , streamly-core
src/Streamly/Data/Fold/Prelude.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Data.Fold.Prelude -- Copyright   : (c) 2021 Composewell Technologies@@ -11,6 +12,12 @@ -- module Streamly.Data.Fold.Prelude     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * "Streamly.Data.Fold"     -- | All "Streamly.Data.Fold" combinators are re-exported via this     -- module. For more pre-release combinators also see@@ -24,10 +31,19 @@     , inspect      -- ** Combinators-    , parEval+    , parBuffered+    , parTee+    , parDistribute+    , parDistributeScan+    , parPartition+    , parDemuxScan+    , parUnzip      -- * Container Related     , toHashMapIO++    -- ** Deprecated+    , parEval     ) where @@ -36,17 +52,15 @@ import Data.Hashable (Hashable) import Streamly.Data.Fold import Streamly.Internal.Data.Fold (toContainerIO)-import Streamly.Internal.Data.Fold.Concurrent+import Streamly.Internal.Data.Fold.Prelude import Streamly.Internal.Data.IsMap.HashMap () +#include "DocTestDataFold.hs"+ -- | Split the input stream based on a hashable component of the key field and -- fold each split using the given fold. Useful for map/reduce, bucketizing -- the input in different bins or for generating histograms. ----- >>> import Data.HashMap.Strict (HashMap, fromList)--- >>> import qualified Streamly.Data.Fold.Prelude as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- -- Consider a stream of key value pairs: -- -- >>> input = Stream.fromList [("k1",1),("k1",1.1),("k2",2), ("k2",2.2)]@@ -54,12 +68,16 @@ -- Classify each key to a different hash bin and fold the bins: -- -- >>> classify = Fold.toHashMapIO fst (Fold.lmap snd Fold.toList)--- >>> Stream.fold classify input :: IO (HashMap String [Double])--- fromList [("k2",[2.0,2.2]),("k1",[1.0,1.1])]+-- >>> sortOn fst . HM.toList <$> Stream.fold classify input :: IO [(String, [Double])]+-- [("k1",[1.0,1.1]),("k2",[2.0,2.2])] -- -- /Pre-release/ -- {-# INLINE toHashMapIO #-}-toHashMapIO :: (MonadIO m, Hashable k, Ord k) =>+toHashMapIO :: (MonadIO m, Hashable k+#if __GLASGOW_HASKELL__ == 810+    , Eq k+#endif+    ) =>     (a -> k) -> Fold m a b -> Fold m a (HashMap k b) toHashMapIO = toContainerIO
+ src/Streamly/Data/Scanl/Prelude.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Scanl.Prelude+-- Copyright   : (c) 2025 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- All Scan related combinators including the streamly-core+-- "Streamly.Data.Scanl" module, concurrency, unordered container operations.+--+module Streamly.Data.Scanl.Prelude+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * "Streamly.Data.Scanl"+    -- | All "Streamly.Data.Scanl" combinators are re-exported via this+    -- module. For more pre-release combinators also see+    -- "Streamly.Internal.Data.Scanl" module.+      module Streamly.Data.Scanl+    -- * Concurrent Operations+    -- ** Configuration+    , Config+    , maxBuffer+    , boundThreads+    , inspect++    -- ** Combinators+    , parTeeWith+    , parDistributeScanM+    , parDistributeScan+    , parDemuxScanM+    , parDemuxScan+    )+where++import Streamly.Data.Scanl+import Streamly.Internal.Data.Scanl.Prelude++#include "DocTestDataScanl.hs"
src/Streamly/Data/Stream/MkType.hs view
@@ -24,62 +24,138 @@ -- >>> import Streamly.Data.Stream.MkType -- >>> import qualified Streamly.Data.Stream.Prelude as Stream ----- For 'Streamly.Prelude.AsyncT' monad type with a concurrent cross product--- bind:+-- We are describing below many useful types that can be created using macros+-- in this module and the behavior of those types. These could be useful if you+-- like to program using the monad \"do notation\" instead of using concatMap+-- like operations. --+-- == Parallel+--+-- An unordered concurrent version of the serial 'Nested' type. Runs multiple+-- iterations of the nested loops concurrently, iterations may execute out of+-- order. More outer iterations are started only if the existing inner+-- iterations are not saturating the resources.+-- -- >>> :{ --  bind = flip (Stream.parConcatMap id)---  $(mkCrossType "AsyncT" "bind" True)+--  $(mkCrossType "Parallel" "bind" True) -- :} ----- For 'Streamly.Prelude.WAsyncT' monad type with a concurrent interleaved--- bind:+-- This is a bounded concurrent, unordered list-transformer (ListT) monad. --+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.AsyncT' type.+--+-- == FairParallel+--+-- Like Parallel but strikes a balance between going deeper into existing+-- iterations of the loop and starting new iterations.+-- -- >>> :{ --  bind = flip (Stream.parConcatMap (Stream.interleaved True))---  $(mkCrossType "WAsyncT" "bind" True)+--  $(mkCrossType "FairParallel" "bind" True) -- :} ----- For 'Streamly.Prelude.AheadT' monad type with a concurrent ordered--- cross product bind:+-- This is a bounded concurrent, fair logic programming (LogicT) monad. --+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.WAsyncT' type.+--+-- == EagerParallel+--+-- Like Parallel, but executes as many actions concurrently as possible. This+-- is useful if you want all actions to be scheduled at the same time so that+-- something does not get starved due to others.+-- -- >>> :{---  bind = flip (Stream.parConcatMap (Stream.ordered True))---  $(mkCrossType "AheadT" "bind" True)+--  parBind = flip (Stream.parConcatMap (Stream.eager True))+--  $(mkCrossType "EagerParallel" "parBind" True) -- :} ----- For 'Streamly.Prelude.ParallelT' monad type with an eager concurrent cross--- product bind:+-- This is an unbounded concurrent, unordered list transformer (ListT) monad. --+-- WARNING! By design, monad bind of this type is not associative, because of+-- concurrency order of effects as well as results may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.ParallelT' type.+--+-- == OrderedParallel+--+-- Like Parallel, runs many iterations concurrently, but stages the results+-- such that the results of iterations are presented in the same order as+-- specified in the code. This is closest to the serial Nested type in behavior+-- among all the concurrent types.+-- -- >>> :{---  parBind = flip (Stream.parConcatMap (Stream.eager True))---  $(mkCrossType "ParallelT" "parBind" True)+--  bind = flip (Stream.parConcatMap (Stream.ordered True))+--  $(mkCrossType "OrderedParallel" "bind" True) -- :} ----- For 'Streamly.Prelude.ZipSerialM' serial zipping applicative type:+-- This is a bounded concurrent, ordered list transformer (ListT) monad. --+-- WARNING! Monad bind of this type is associative for values, but because of+-- concurrency, order of effects may be unpredictable.+--+-- Same as the deprecated 'Streamly.Prelude.AheadT' type.+--+-- == Zip+--+-- An applicative type to zip two streams.+-- -- >>> :{ --  zipApply = Stream.zipWith ($)---  $(mkZipType "ZipSerialM" "zipApply" False)+--  $(mkZipType "Zip" "zipApply" False) -- :} ----- For 'Streamly.Prelude.ZipAsync' concurrent zipping applicative type:+-- Same as the deprcated 'Streamly.Prelude.ZipSerialM' type. --+-- == ParZip+--+-- Like Zip but evaluates the two streams concurrently.+-- -- >>> :{---  parApply = Stream.parApply id---  $(mkZipType "ZipAsync" "parApply" True)+--  parCrossApply = Stream.parCrossApply id+--  $(mkZipType "ParZip" "parCrossApply" True) -- :} ----- Instead of using these macros directly you could use the generated code as--- well. Use these macros in ghci to generate the required code and paste it in--- your package, you can customize the code as desired. See the docs of the--- macros below for examples about how to view the generated code. For example:+-- Same as the deprecated 'Streamly.Prelude.ZipAsync' type. --+-- == Avoiding Template Haskell+--+-- Instead of using these macros directly you could copy and paste the+-- generated code as well. Use these macros in ghci to generate the required+-- code and paste it in your package, you can customize the code as desired.+-- See the docs of the macros below for examples about how to view the+-- generated code. For example:+-- -- >>> bind = flip (Stream.parConcatMap id) -- >>> expr <- runQ (mkCrossType "AsyncT" "bind" True) -- -- >> putStrLn $ pprint expr++-- XXX TBD --+-- == Nested+--+-- A serial cross monad type, same as 'Streamly.Data.StreamK.Nested' but with+-- mtl instances.+--+-- == FairNested+--+-- Like Nested but strikes a balance between going deeper into existing+-- iterations of the loop and starting new iterations. Same as+-- 'Streamly.Data.StreamK.FairNested' but additional with mtl instances.+--+-- == InvertedParallel+--+-- gives more priority to opening new iterations than to run existing+-- iterations. The interleaved options should be diagonal, and interleaved can+-- be for giving priority to iterations.+ module Streamly.Data.Stream.MkType     (     -- * Imports for Examples
src/Streamly/Data/Stream/Prelude.hs view
@@ -54,6 +54,10 @@     , ordered     , interleaved +    -- *** Resource management+    , useAcquire+    , clearAcquire+     -- *** Diagnostics     , inspect @@ -64,7 +68,7 @@     -- | Evaluate a stream as a whole concurrently with respect to the consumer     -- of the stream. -    , parEval+    , parBuffered      -- *** Generate     -- | Generate a stream by evaluating multiple actions concurrently.@@ -98,7 +102,7 @@     -- *** Stream of streams     -- **** Apply -    , parApply+    , parCrossApply      -- **** Concat     -- | Shares a single channel across many streams.@@ -138,6 +142,8 @@      -- ** Deprecated     , tapCount+    , parEval+    , parApply     ) where @@ -156,15 +162,15 @@ -- -- == Primitives ----- There are only a few fundamental abstractions for concurrency, 'parEval',+-- There are only a few fundamental abstractions for concurrency, 'parBuffered', -- 'parConcatMap', and 'parConcatIterate', all concurrency combinators can be -- expressed in terms of these. ----- 'parEval' evaluates a stream as a whole asynchronously with respect to+-- 'parBuffered' evaluates a stream as a whole asynchronously with respect to -- the consumer of the stream. A worker thread evaluates multiple elements of -- the stream ahead of time and buffers the results; the consumer of the stream -- runs in another thread consuming the elements from the buffer, thus--- decoupling the production and consumption of the stream. 'parEval' can be+-- decoupling the production and consumption of the stream. 'parBuffered' can be -- used to run different stages of a pipeline concurrently. -- -- 'parConcatMap' is used to evaluate multiple actions in a stream concurrently@@ -217,8 +223,8 @@ -- Using the few fundamental concurrency primitives we can implement all the -- usual streaming combinators with concurrent behavior. Combinators like -- 'unfoldrM', 'iterateM' that are inherently serial can be evaluated--- concurrently with respect to the consumer pipeline using 'parEval'.--- Combinators like 'zipWithM', 'mergeByM' can also use 'parEval' on the input+-- concurrently with respect to the consumer pipeline using 'parBuffered'.+-- Combinators like 'zipWithM', 'mergeByM' can also use 'parBuffered' on the input -- streams to evaluate them concurrently before combining. -- -- Combinators like 'repeatM', 'replicateM', 'fromListM', 'sequence', 'mapM' in
src/Streamly/Internal/Control/ForkLifted.hs view
@@ -18,7 +18,8 @@ import Control.Concurrent (ThreadId, forkIO, forkOS) import Control.Exception (SomeException(..), catch, mask) import Data.Functor (void)-import Streamly.Internal.Control.Concurrent (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, RunInIO(..), withRunInIO, withRunInIONoRestore) import Streamly.Internal.Control.ForkIO (rawForkIO, forkManagedWith)  -- | Fork a thread to run the given computation, installing the provided@@ -47,9 +48,8 @@ doForkWith bound action (RunInIO mrun) exHandler =     withRunInIO $ \run ->         mask $ \restore -> do-                tid <- (if bound then forkOS else rawForkIO) $-                    catch (restore $ void $ mrun action)-                          exHandler+                let frk = if bound then forkOS else rawForkIO+                tid <- frk $ catch (restore $ void $ mrun action) exHandler                 run (return tid)  -- | 'fork' lifted to any monad with 'MonadBaseControl IO m' capability.
src/Streamly/Internal/Data/Channel.hs view
@@ -5,11 +5,22 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC+--+-- This module contains operations that are common for Stream and Fold+-- channels.  module Streamly.Internal.Data.Channel     (-      module Streamly.Internal.Data.Channel.Dispatcher-    , module Streamly.Internal.Data.Channel.Types+    -- * Channel Config & Stats+      module Streamly.Internal.Data.Channel.Types+    -- * Worker Dispatcher+    -- | Operations used by the consumer of the channel.+    , module Streamly.Internal.Data.Channel.Dispatcher+    -- * Channel Workers+    -- | Operations used by the workers (producers) of the channel. These+    -- operations are thread-safe, these can be called concurrently by workers+    -- working in independent Haskell threads, the shared channel data+    -- structures are read or updated atomically.     , module Streamly.Internal.Data.Channel.Worker     ) where
src/Streamly/Internal/Data/Channel/Dispatcher.hs view
@@ -9,18 +9,18 @@ -- module Streamly.Internal.Data.Channel.Dispatcher     (-    -- * Latency collection+    -- ** Latency collection       minThreadDelay     , collectLatency -    -- * Thread accounting+    -- ** Thread accounting     , addThread     , delThread     , modifyThread     , allThreadsDone     , recordMaxWorkers -    -- * Diagnostics+    -- ** Diagnostics     , dumpSVarStats     ) where@@ -32,7 +32,8 @@ import Control.Monad (when, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Data.IORef (IORef, modifyIORef, readIORef, writeIORef)-import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS, writeBarrier)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, writeBarrier, atomicModifyIORefCAS_) import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import Streamly.Internal.Data.Time.Units        ( AbsTime, NanoSecond64(..), diffAbsTime64, showNanoSecond64@@ -57,7 +58,7 @@ minThreadDelay :: NanoSecond64 minThreadDelay = 1000000 --- Every once in a while workers update the latencies and check the yield rate.+-- | Every once in a while workers update the latencies and check the yield rate. -- They return if we are above the expected yield rate. If we check too often -- it may impact performance, if we check less often we may have a stale -- picture. We update every minThreadDelay but we translate that into a yield@@ -70,7 +71,11 @@ updateWorkerPollingInterval :: YieldRateInfo -> NanoSecond64 -> IO () updateWorkerPollingInterval yinfo latency = do     let periodRef = workerPollingInterval yinfo-        cnt = max 1 $ minThreadDelay `div` latency+        -- This depends on the rate, if the rate is low, latencies are+        -- small, by the time we poll it might be too late and we may have+        -- yielded too many results.+        -- cnt = max 1 $ minThreadDelay `div` latency+        cnt = max 1 (latency `div` svarLatencyTarget yinfo)         period = min cnt (fromIntegral magicMaxBuffer)      writeIORef periodRef (fromIntegral period)@@ -90,12 +95,16 @@     modifyIORef (avgWorkerLatency ss) $         \(cnt, t) -> (cnt + count, t + time) --- Pour the pending latency stats into a collection bucket+-- | Add the 'workerPendingLatency' to 'workerCollectedLatency' and reset it to+-- zeroes. Return the added counts. {-# INLINE collectWorkerPendingLatency #-} collectWorkerPendingLatency-    :: IORef (Count, Count, NanoSecond64)-    -> IORef (Count, Count, NanoSecond64)+    :: IORef (Count, Count, NanoSecond64) -- ^ 'workerPendingLatency'+    -> IORef (Count, Count, NanoSecond64) -- ^ 'workerCollectedLatency'     -> IO (Count, Maybe (Count, NanoSecond64))+    -- ^ (total yield count, Maybe (total latency count, total latency time)).+    -- Latency count and time are reported only when both are non-zero to avoid+    -- arithemetic exceptions in calculations. collectWorkerPendingLatency cur col = do     (fcount, count, time) <- atomicModifyIORefCAS cur $ \v -> ((0,0,0), v) @@ -126,18 +135,31 @@         || (prevLat > 0 && (r > 2 || r < 0.5))         || (prevLat == 0) --- Returns a triple, (1) yield count since last collection, (2) the base time--- when we started counting, (3) average latency in the last measurement--- period. The former two are used for accurate measurement of the going rate--- whereas the average is used for future estimates e.g. how many workers--- should be maintained to maintain the rate. -- CAUTION! keep it in sync with getWorkerLatency++-- | Always moves 'workerPendingLatency' to 'workerCollectedLatency':+--+--  * 'workerCollectedLatency' always incremented by 'workerPendingLatency'+--  * 'workerPendingLatency' always reset to 0+--+-- Moves 'workerCollectedLatency' to 'svarAllTimeLatency' periodically, when+-- the collected batch size hits a limit, or time limit is over, or latency+-- changes beyond a limit. Updates done when the batch is collected:+--+--  * 'svarAllTimeLatency' yield count updated+--  * 'workerMeasuredLatency' set to (new+prev)/2+--  * 'workerPollingInterval' set using max of new/prev worker latency+--  * 'workerCollectedLatency' reset to 0+--+-- See also 'getWorkerLatency'.+-- collectLatency ::-       Bool-    -> SVarStats-    -> YieldRateInfo-    -> Bool+       Bool -- ^ stat inspection mode+    -> SVarStats -- ^ Channel stats+    -> YieldRateInfo -- ^ Channel rate control info+    -> Bool -- ^ Force batch collection     -> IO (Count, AbsTime, NanoSecond64)+    -- ^ (channel yield count since beginning, beginning timestamp, 'workerMeasuredLatency') collectLatency inspecting ss yinfo drain = do     let cur      = workerPendingLatency yinfo         col      = workerCollectedLatency yinfo@@ -190,47 +212,55 @@     minLat <- readIORef $ minWorkerLatency ss     maxLat <- readIORef $ maxWorkerLatency ss     (avgCnt, avgTime) <- readIORef $ avgWorkerLatency ss-    (svarCnt, svarGainLossCnt, svarLat) <- case rateInfo of-        Nothing -> return (0, 0, 0)+    stopTime <- readIORef (svarStopTime ss)+    let stopReason =+            case stopTime of+                Nothing -> "stream abandoned"+                Just _ -> "stream finished"+    (svarCnt, svarGainLossCnt, svarLat, interval) <- case rateInfo of+        Nothing -> return (0, 0, 0, 0)         Just yinfo -> do             (cnt, startTime) <- readIORef $ svarAllTimeLatency yinfo+            interval <-+                case stopTime of+                    Nothing -> do+                        now <- getTime Monotonic+                        return (diffAbsTime64 now startTime)+                    Just t -> do+                        return (diffAbsTime64 t startTime)             if cnt > 0             then do-                t <- readIORef (svarStopTime ss)                 gl <- readIORef (svarGainedLostYields yinfo)-                case t of-                    Nothing -> do-                        now <- getTime Monotonic-                        let interval = diffAbsTime64 now startTime-                        return (cnt, gl, interval `div` fromIntegral cnt)-                    Just stopTime -> do-                        let interval = diffAbsTime64 stopTime startTime-                        return (cnt, gl, interval `div` fromIntegral cnt)-            else return (0, 0, 0)+                return (cnt, gl, interval `div` fromIntegral cnt, interval)+            else return (0, 0, 0, interval) -    return $ unlines-        [ "total dispatches = " <> show dispatches-        , "max workers = " <> show maxWrk-        , "max outQSize = " <> show maxOq-            <> (if minLat > 0-               then "\nmin worker latency = " <> showNanoSecond64 minLat-               else "")-            <> (if maxLat > 0-               then "\nmax worker latency = " <> showNanoSecond64 maxLat-               else "")-            <> (if avgCnt > 0-                then let lat = avgTime `div` fromIntegral avgCnt-                     in "\navg worker latency = " <> showNanoSecond64 lat-                else "")-            <> (if svarLat > 0-               then "\nSVar latency = " <> showRelTime64 svarLat-               else "")-            <> (if svarCnt > 0-               then "\nSVar yield count = " <> show svarCnt-               else "")-            <> (if svarGainLossCnt > 0-               then "\nSVar gain/loss yield count = " <> show svarGainLossCnt-               else "")+    return $ concat+        [ "stop reason = " <> stopReason+        ,  if interval > 0+           then "\nlife time = " <> showRelTime64 interval+           else ""+        , "\ntotal dispatches = " <> show dispatches+        , "\nmax workers = " <> show maxWrk+        , "\nmax outQSize = " <> show maxOq+        , if minLat > 0+          then "\nmin worker latency = " <> showNanoSecond64 minLat+          else ""+        , if maxLat > 0+          then "\nmax worker latency = " <> showNanoSecond64 maxLat+          else ""+        , if avgCnt > 0+          then let lat = avgTime `div` fromIntegral avgCnt+                in "\navg worker latency = " <> showNanoSecond64 lat+          else ""+        , if svarLat > 0+          then "\nchannel latency = " <> showRelTime64 svarLat+          else ""+        , if svarCnt > 0+          then "\nchannel yield count = " <> show svarCnt+          else ""+        , if svarGainLossCnt > 0+          then "\nchannel gain/loss yield count = " <> show svarGainLossCnt+          else ""         ]  -------------------------------------------------------------------------------@@ -248,7 +278,7 @@ {-# NOINLINE addThread #-} addThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m () addThread workerSet tid =-    liftIO $ modifyIORef workerSet (S.insert tid)+    liftIO $ atomicModifyIORefCAS_ workerSet (S.insert tid)  -- This is cheaper than modifyThread because we do not have to send a -- outputDoorBell This can make a difference when more workers are being@@ -256,7 +286,7 @@ {-# INLINE delThread #-} delThread :: MonadIO m => IORef (Set ThreadId) -> ThreadId -> m () delThread workerSet tid =-    liftIO $ modifyIORef workerSet (S.delete tid)+    liftIO $ atomicModifyIORefCAS_ workerSet (S.delete tid)  -- If present then delete else add. This takes care of out of order add and -- delete i.e. a delete arriving before we even added a thread.
src/Streamly/Internal/Data/Channel/Types.hs view
@@ -33,75 +33,36 @@ -- module Streamly.Internal.Data.Channel.Types     (-    -- * Types+    -- ** Types       Count (..)     , Limit (..)     , ThreadAbort (..)     , ChildEvent (..) -    -- * Stats+    -- ** Stats     , SVarStats (..)     , newSVarStats -    -- * Rate Control+    -- ** Rate Control     , WorkerInfo (..)     , LatencyRange (..)     , YieldRateInfo (..)-    , newRateInfo -    -- * Output queue+    -- ** Output queue     , readOutputQRaw     , readOutputQBasic     , ringDoorBell -    -- * Yield Limit+    -- ** Yield Limit     , decrementYieldLimit     , incrementYieldLimit -    -- * Configuration+    -- ** Configuration     , Rate (..)     , StopWhen (..)-    , Config--    -- ** Default config     , magicMaxBuffer-    , defaultConfig -    -- ** Set config-    , maxThreads-    , maxBuffer-    , maxYields-    , inspect-    , eager-    , stopWhen-    , ordered-    , interleaved-    , boundThreads--    , rate-    , avgRate-    , minRate-    , maxRate-    , constRate--    -- ** Get config-    , getMaxThreads-    , getMaxBuffer-    , getStreamRate-    , getStreamLatency-    , setStreamLatency-    , getYieldLimit-    , getInspectMode-    , getEagerDispatch-    , getStopWhen-    , getOrdered-    , getInterleaved-    , getBound--    -- * Cleanup-    , cleanupSVar--    -- * Diagnostics+    -- ** Diagnostics     , dumpCreator     , dumpOutputQ     , dumpDoorBell@@ -114,7 +75,7 @@     ) where -import Control.Concurrent (ThreadId, throwTo, MVar, tryReadMVar)+import Control.Concurrent (ThreadId, MVar, tryReadMVar) import Control.Concurrent.MVar (tryPutMVar) import Control.Exception     ( SomeException(..), Exception, catches, throwIO, Handler(..)@@ -122,15 +83,11 @@ import Control.Monad (void, when) import Data.Int (Int64) import Data.IORef (IORef, newIORef, readIORef, writeIORef)-import Data.Set (Set) import Streamly.Internal.Data.Atomics     (atomicModifyIORefCAS, atomicModifyIORefCAS_, storeLoadBarrier)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime) import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..)) import System.IO (hPutStrLn, stderr) -import qualified Data.Set as Set- ------------------------------------------------------------------------------ -- Common types ------------------------------------------------------------------------------@@ -186,11 +143,11 @@ -- a particular rate when controlled pace mode it used. data WorkerInfo = WorkerInfo     {-    -- | 0 means unlimited+    -- | Yields allowed for this worker. 0 means unlimited.       workerYieldMax   :: Count     -- | total number of yields by the worker till now     , workerYieldCount    :: IORef Count-    -- | yieldCount at start, timestamp+    -- | (yield count at start of collection interval, collection start timestamp)     , workerLatencyStart  :: IORef (Count, AbsTime)     } @@ -203,61 +160,70 @@ data YieldRateInfo = YieldRateInfo     { svarLatencyTarget    :: NanoSecond64     , svarLatencyRange     :: LatencyRange-    , svarRateBuffer       :: Int -    -- | [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- | Number of yields beyond which we will not try to recover the rate.+    , svarRateBuffer :: Int++    -- | Yields that we have permanently gained or lost since the start of the+    -- channel i.e. we do not want to adjust the rate to make up for this+    -- deficit or gain.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot     -- read by the worker threads     , svarGainedLostYields :: IORef Count -    -- | Actual latency/througput as seen from the consumer side, we count the-    -- yields and the time it took to generates those yields. This is used to-    -- increase or decrease the number of workers needed to achieve the desired-    -- rate. The idle time of workers is adjusted in this, so that we only-    -- account for the rate when the consumer actually demands data.     -- XXX interval latency is enough, we can move this under diagnostics build-    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely-    -- read by the worker threads++    -- | (channel yields from start till now, channel start timestamp) as+    -- recorded by the consumer side of the channel.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread, snapshot+    -- read by the worker threads.     , svarAllTimeLatency :: IORef (Count, AbsTime) -    -- XXX Worker latency specified by the user to be used before the first-    -- actual measurement arrives. Not yet implemented+    -- | TODO. Not yet implemented. Worker latency specified by the user to be+    -- used as a guide before the first actual measurement arrives.     , workerBootstrapLatency :: Maybe NanoSecond64 -    -- | After how many yields the worker should update the latency information.-    -- If the latency is high, this count is kept lower and vice-versa.  XXX If-    -- the latency suddenly becomes too high this count may remain too high for-    -- long time, in such cases the consumer can change it.-    -- 0 means no latency computation+    -- XXX If the latency suddenly becomes too high this count may remain too+    -- high for long time, in such cases the consumer can change it. 0 means no+    -- latency computation     -- XXX this is derivable from workerMeasuredLatency, can be removed.-    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely++    -- | After how many yields the worker should update the latency+    -- information. If the 'workerMeasuredLatency' is high, this count is kept+    -- lower and vice-versa.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot     -- read by the worker threads     , workerPollingInterval :: IORef Count -    -- | This is in progress latency stats maintained by the workers which we-    -- empty into workerCollectedLatency stats at certain intervals - whenever-    -- we process the stream elements yielded in this period. The first count-    -- is all yields, the second count is only those yields for which the-    -- latency was measured to be non-zero (note that if the timer resolution-    -- is low the measured latency may be zero e.g. on JS platform).-    -- [LOCKING] Locked access. Modified by the consumer thread as well as-    -- worker threads. Workers modify it periodically based on+    -- | (total yields, measured yields, time taken by measured yields).+    -- This is first level collection bucket which is continuously updated by+    -- workers and periodically emptied and collected into+    -- 'workerCollectedLatency' by the consumer thread.+    --+    -- "Measured yields" are only those yields for which the latency was+    -- measured to be non-zero (note that if the timer resolution is low the+    -- measured latency may be zero e.g. on JS platform).+    --+    -- [LOCKING] Locked access. Atomically modified by the consumer thread as+    -- well as worker threads. Workers modify it periodically based on     -- workerPollingInterval and not on every yield to reduce the locking     -- overhead.-    -- (allYieldCount, yieldCount, timeTaken)     , workerPendingLatency   :: IORef (Count, Count, NanoSecond64) -    -- | This is the second level stat which is an accmulation from-    -- workerPendingLatency stats. We keep accumulating latencies in this-    -- bucket until we have stats for a sufficient period and then we reset it-    -- to start collecting for the next period and retain the computed average-    -- latency for the last period in workerMeasuredLatency.-    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- | 'workerPendingLatency' is periodically reset and aggregated into this+    -- by the consumer thread. This itself is reset periodically and+    -- 'svarAllTimeLatency', 'workerMeasuredLatency' are updated using it.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot     -- read by the worker threads-    -- (allYieldCount, yieldCount, timeTaken)     , workerCollectedLatency :: IORef (Count, Count, NanoSecond64) -    -- | Latency as measured by workers, aggregated for the last period.-    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- | Weighted average of worker latencies in previous measurement periods.+    --+    -- [LOCKING] Unlocked access. Modified by the consumer thread and snapshot     -- read by the worker threads     , workerMeasuredLatency :: IORef NanoSecond64     }@@ -284,8 +250,8 @@ -- start of time. If the consumer or the producer is slower or faster, the -- actual rate may fall behind or exceed 'rateGoal'.  We try to recover the gap -- between the two by increasing or decreasing the pull rate from the producer.--- However, if the gap becomes more than 'rateBuffer' we try to recover only as--- much as 'rateBuffer'.+-- However, if the yield count gap becomes more than 'rateBuffer' (specified as+-- a yield count) we try to recover only as much as 'rateBuffer'. -- -- 'rateLow' puts a bound on how low the instantaneous rate can go when -- recovering the rate gap.  In other words, it determines the maximum yield@@ -298,10 +264,10 @@ -- If the 'rateBuffer' is 0 or negative we do not attempt to recover. -- data Rate = Rate-    { rateLow    :: Double -- ^ The lower rate limit+    { rateLow    :: Double -- ^ The lower rate limit (yields per sec)     , rateGoal   :: Double -- ^ The target rate we want to achieve     , rateHigh   :: Double -- ^ The upper rate limit-    , rateBuffer :: Int    -- ^ Maximum slack from the goal+    , rateBuffer :: Int    -- ^ Maximum yield count slack from the goal     }  -- | Specify when the 'Channel' should stop.@@ -310,41 +276,6 @@     | AllStop    -- ^ Stop when all the streams end.     | AnyStops   -- ^ Stop when any one stream ends. --- XXX we can put the resettable fields in a oneShotConfig field and others in--- a persistentConfig field. That way reset would be fast and scalable--- irrespective of the number of fields.------ XXX make all these Limited types and use phantom types to distinguish them---- | An abstract type for specifying the configuration parameters of a--- 'Channel'. Use @Config -> Config@ modifier functions to modify the default--- configuration. See the individual modifier documentation for default values.----data Config = Config-    { -- one shot configuration, automatically reset for each API call-      -- streamVar   :: Maybe (SVar t m a)-      _yieldLimit  :: Maybe Count--    -- persistent configuration, state that remains valid until changed by-    -- an explicit setting via a combinator.-    , _threadsHigh    :: Limit-    , _bufferHigh     :: Limit--    -- XXX these two can be collapsed into a single type-    , _streamLatency  :: Maybe NanoSecond64 -- bootstrap latency-    , _maxStreamRate  :: Maybe Rate-    , _inspect    :: Bool-    , _eagerDispatch  :: Bool-    , _stopWhen :: StopWhen-    , _ordered :: Bool-    , _interleaved :: Bool-    , _bound :: Bool-    }------------------------------------------------------------------------------------ State defaults and reset--------------------------------------------------------------------------------- -- | A magical value for the buffer size arrived at by running the smallest -- possible task and measuring the optimal value of the buffer for that.  This -- is obviously dependent on hardware, this figure is based on a 2.2GHz intel@@ -352,248 +283,6 @@ magicMaxBuffer :: Word magicMaxBuffer = 1500 -defaultMaxThreads, defaultMaxBuffer :: Limit-defaultMaxThreads = Limited magicMaxBuffer-defaultMaxBuffer = Limited magicMaxBuffer---- | The fields prefixed by an _ are not to be accessed or updated directly but--- via smart accessor APIs. Use get/set routines instead of directly accessing--- the Config fields-defaultConfig :: Config-defaultConfig = Config-    { -- streamVar = Nothing-      _yieldLimit = Nothing-    , _threadsHigh = defaultMaxThreads-    , _bufferHigh = defaultMaxBuffer-    , _maxStreamRate = Nothing-    , _streamLatency = Nothing-    , _inspect = False-    -- XXX Set it to True when Rate is not set?-    , _eagerDispatch = False-    , _stopWhen = AllStop-    , _ordered = False-    , _interleaved = False-    , _bound = False-    }------------------------------------------------------------------------------------ Smart get/set routines for State----------------------------------------------------------------------------------maxYields :: Maybe Int64 -> Config -> Config-maxYields lim st =-    st { _yieldLimit =-            case lim of-                Nothing -> Nothing-                Just n  ->-                    if n <= 0-                    then Just 0-                    else Just (fromIntegral n)-       }--getYieldLimit :: Config -> Maybe Count-getYieldLimit = _yieldLimit---- | Specify the maximum number of threads that can be spawned by the channel.--- A value of 0 resets the thread limit to default, a negative value means--- there is no limit. The default value is 1500.------ When the actions in a stream are IO bound, having blocking IO calls, this--- option can be used to control the maximum number of in-flight IO requests.--- When the actions are CPU bound this option can be used to control the amount--- of CPU used by the stream.----maxThreads :: Int -> Config -> Config-maxThreads n st =-    st { _threadsHigh =-            if n < 0-            then Unlimited-            else if n == 0-                 then defaultMaxThreads-                 else Limited (fromIntegral n)-       }--getMaxThreads :: Config -> Limit-getMaxThreads = _threadsHigh---- | Specify the maximum size of the buffer for storing the results from--- concurrent computations. If the buffer becomes full we stop spawning more--- concurrent tasks until there is space in the buffer.--- A value of 0 resets the buffer size to default, a negative value means--- there is no limit. The default value is 1500.------ CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)--- coupled with an unbounded 'maxThreads' value is a recipe for disaster in--- presence of infinite streams, or very large streams.  Especially, it must--- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in--- applicative zip streams generates an infinite stream causing unbounded--- concurrent generation with no limit on the buffer or threads.----maxBuffer :: Int -> Config -> Config-maxBuffer n st =-    st { _bufferHigh =-            if n < 0-            then Unlimited-            else if n == 0-                 then defaultMaxBuffer-                 else Limited (fromIntegral n)-       }--getMaxBuffer :: Config -> Limit-getMaxBuffer = _bufferHigh---- | Specify the stream evaluation rate of a channel.------ A 'Nothing' value means there is no smart rate control, concurrent execution--- blocks only if 'maxThreads' or 'maxBuffer' is reached, or there are no more--- concurrent tasks to execute. This is the default.------ When rate (throughput) is specified, concurrent production may be ramped--- up or down automatically to achieve the specified stream throughput. The--- specific behavior for different styles of 'Rate' specifications is--- documented under 'Rate'.  The effective maximum production rate achieved by--- a channel is governed by:------ * The 'maxThreads' limit--- * The 'maxBuffer' limit--- * The maximum rate that the stream producer can achieve--- * The maximum rate that the stream consumer can achieve------ Maximum production rate is given by:------ \(rate = \frac{maxThreads}{latency}\)------ If we know the average latency of the tasks we can set 'maxThreads'--- accordingly.----rate :: Maybe Rate -> Config -> Config-rate r st = st { _maxStreamRate = r }--getStreamRate :: Config -> Maybe Rate-getStreamRate = _maxStreamRate--setStreamLatency :: Int -> Config -> Config-setStreamLatency n st =-    st { _streamLatency =-            if n <= 0-            then Nothing-            else Just (fromIntegral n)-       }--getStreamLatency :: Config -> Maybe NanoSecond64-getStreamLatency = _streamLatency---- XXX Rename to "inspect"---- | Print debug information about the 'Channel' when the stream ends.----inspect :: Bool -> Config -> Config-inspect flag st = st { _inspect = flag }--getInspectMode :: Config -> Bool-getInspectMode = _inspect---- | By default, processing of output from the worker threads is given priority--- over dispatching new workers. More workers are dispatched only when there is--- no output to process. When 'eager' is set to 'True', workers are dispatched--- aggresively as long as there is more work to do irrespective of whether--- there is output pending to be processed by the stream consumer. However,--- dispatching may stop if 'maxThreads' or 'maxBuffer' is reached.------ /Note:/ This option has no effect when rate has been specified.------ /Note:/ Not supported with 'interleaved'.----eager :: Bool -> Config -> Config-eager flag st = st { _eagerDispatch = flag }--getEagerDispatch :: Config -> Bool-getEagerDispatch = _eagerDispatch---- | Specify when the 'Channel' should stop.-stopWhen :: StopWhen -> Config -> Config-stopWhen cond st = st { _stopWhen = cond }--getStopWhen :: Config -> StopWhen-getStopWhen = _stopWhen---- | When enabled the streams may be evaluated cocnurrently but the results are--- produced in the same sequence as a serial evaluation would produce.------ /Note:/ Not supported with 'interleaved'.----ordered :: Bool -> Config -> Config-ordered flag st = st { _ordered = flag }--getOrdered :: Config -> Bool-getOrdered = _ordered---- | Interleave the streams fairly instead of prioritizing the left stream.--- This schedules all streams in a round robin fashion over limited number of--- threads.------ /Note:/ Can only be used on finite number of streams.------ /Note:/ Not supported with 'ordered'.----interleaved :: Bool -> Config -> Config-interleaved flag st = st { _interleaved = flag }--getInterleaved :: Config -> Bool-getInterleaved = _interleaved---- TODO: Make it consistently take effect everywhere.---- | Spawn bound threads (i.e., spawn threads using 'forkOS' instead of--- 'forkIO'). The default value is 'False'.------ Currently, this only takes effect only for concurrent folds.-boundThreads :: Bool -> Config -> Config-boundThreads flag st = st { _bound = flag }--getBound :: Config -> Bool-getBound = _bound------------------------------------------------------------------------------------ Initialization----------------------------------------------------------------------------------newRateInfo :: Config -> IO (Maybe YieldRateInfo)-newRateInfo st = do-    -- convert rate in Hertz to latency in Nanoseconds-    let rateToLatency r = if r <= 0 then maxBound else round $ 1.0e9 / r-    case getStreamRate st of-        Just (Rate low goal high buf) ->-            let l    = rateToLatency goal-                minl = rateToLatency high-                maxl = rateToLatency low-            in mkYieldRateInfo l (LatencyRange minl maxl) buf-        Nothing -> return Nothing--    where--    mkYieldRateInfo latency latRange buf = do-        measured <- newIORef 0-        wcur     <- newIORef (0,0,0)-        wcol     <- newIORef (0,0,0)-        now      <- getTime Monotonic-        wlong    <- newIORef (0,now)-        period   <- newIORef 1-        gainLoss <- newIORef (Count 0)--        return $ Just YieldRateInfo-            { svarLatencyTarget      = latency-            , svarLatencyRange       = latRange-            , svarRateBuffer         = buf-            , svarGainedLostYields   = gainLoss-            , workerBootstrapLatency = getStreamLatency st-            , workerPollingInterval  = period-            , workerMeasuredLatency  = measured-            , workerPendingLatency   = wcur-            , workerCollectedLatency = wcol-            , svarAllTimeLatency     = wlong-            }- newSVarStats :: IO SVarStats newSVarStats = do     disp   <- newIORef 0@@ -619,54 +308,6 @@         }  ---------------------------------------------------------------------------------- Rate------------------------------------------------------------------------------------ | Same as @rate (Just $ Rate (r/2) r (2*r) maxBound)@------ Specifies the average production rate of a stream in number of yields--- per second (i.e.  @Hertz@).  Concurrent production is ramped up or down--- automatically to achieve the specified average yield rate. The rate can--- go down to half of the specified rate on the lower side and double of--- the specified rate on the higher side.----avgRate :: Double -> Config -> Config-avgRate r = rate (Just $ Rate (r/2) r (2*r) maxBound)---- | Same as @rate (Just $ Rate r r (2*r) maxBound)@------ Specifies the minimum rate at which the stream should yield values. As--- far as possible the yield rate would never be allowed to go below the--- specified rate, even though it may possibly go above it at times, the--- upper limit is double of the specified rate.----minRate :: Double -> Config -> Config-minRate r = rate (Just $ Rate r r (2*r) maxBound)---- | Same as @rate (Just $ Rate (r/2) r r maxBound)@------ Specifies the maximum rate at which the stream should yield values. As--- far as possible the yield rate would never be allowed to go above the--- specified rate, even though it may possibly go below it at times, the--- lower limit is half of the specified rate. This can be useful in--- applications where certain resource usage must not be allowed to go--- beyond certain limits.----maxRate :: Double -> Config -> Config-maxRate r = rate (Just $ Rate (r/2) r r maxBound)---- | Same as @rate (Just $ Rate r r r 0)@------ Specifies a constant yield rate. If for some reason the actual rate--- goes above or below the specified rate we do not try to recover it by--- increasing or decreasing the rate in future.  This can be useful in--- applications like graphics frame refresh where we need to maintain a--- constant refresh rate.----constRate :: Double -> Config -> Config-constRate r = rate (Just $ Rate r r r 0)--------------------------------------------------------------------------------- -- Channel yield count ------------------------------------------------------------------------------- @@ -705,13 +346,21 @@ -- Output queue ------------------------------------------------------------------------------- +-- | Read the output queue of the channel. After reading set it to empty list+-- and 0 count. {-# INLINE readOutputQBasic #-}-readOutputQBasic :: IORef ([ChildEvent a], Int) -> IO ([ChildEvent a], Int)+readOutputQBasic ::+       IORef ([a], Int) -- ^ The channel output queue+    -> IO ([a], Int) -- ^ (events, count) readOutputQBasic q = atomicModifyIORefCAS q $ \x -> (([],0), x) +-- | Same as 'readOutputQBasic' but additionally update the max output queue+-- size channel stat if the new size is more than current max. {-# INLINE readOutputQRaw #-} readOutputQRaw ::-    IORef ([ChildEvent a], Int) -> Maybe SVarStats -> IO ([ChildEvent a], Int)+       IORef ([ChildEvent a], Int) -- ^ Channel output queue+    -> Maybe SVarStats -- ^ Channel stats+    -> IO ([ChildEvent a], Int) -- ^ (events, count) readOutputQRaw q stats = do     (list, len) <- readOutputQBasic q     case stats of@@ -722,8 +371,13 @@         Nothing -> return ()     return (list, len) +-- | RingArray door bell. The IORef is read after adding a store-load barrier. If+-- the IORef was set to 'True' it is atomically reset to 'False'. {-# INLINE ringDoorBell #-}-ringDoorBell :: IORef Bool -> MVar () -> IO ()+ringDoorBell ::+       IORef Bool -- ^ If 'True' only then ring the door bell+    -> MVar () -- ^ Door bell, put () to ring+    -> IO () ringDoorBell needBell bell = do     storeLoadBarrier     w <- readIORef needBell@@ -802,16 +456,3 @@ printSVar dump how = do     svInfo <- dump     hPutStrLn stderr $ "\n" <> how <> "\n" <> svInfo------------------------------------------------------------------------------------ Cleanup------------------------------------------------------------------------------------ | Never called from a worker thread.-cleanupSVar :: IORef (Set ThreadId) -> IO ()-cleanupSVar workerSet = do-    workers <- readIORef workerSet-    -- self <- myThreadId-    Prelude.mapM_ (`throwTo` ThreadAbort)-          -- (Prelude.filter (/= self) $ Set.toList workers)-          (Set.toList workers)
src/Streamly/Internal/Data/Channel/Worker.hs view
@@ -10,16 +10,17 @@  module Streamly.Internal.Data.Channel.Worker     (+    -- ** Worker Rate Control       Work (..)     , estimateWorkers     , isBeyondMaxRate-    , workerRateControl+    , incrWorkerYieldCount -    -- * Send Events-    , sendWithDoorBell+    -- ** Workers Sending Events+    , sendEvent     , sendYield     , sendStop-    , handleChildException -- XXX rename to sendException+    , sendException     ) where @@ -56,10 +57,16 @@ -- Sending results from worker ------------------------------------------------------------------------------- -{-# INLINE sendWithDoorBell #-}-sendWithDoorBell ::-    IORef ([ChildEvent a], Int) -> MVar () -> ChildEvent a -> IO Int-sendWithDoorBell q bell msg = do+-- | Low level API to add an event on the channel's output queue. Atomically+-- adds the event to the queue and rings the doorbell if needed to wakeup the+-- consumer thread.+{-# INLINE sendEvent #-}+sendEvent ::+       IORef ([a], Int) -- ^ Queue where the event is added+    -> MVar () -- ^ Door bell to ring+    -> a -- ^ The event to be added+    -> IO Int -- ^ Length of the queue before adding this event+sendEvent q bell msg = do     -- XXX can the access to outputQueue be made faster somehow?     oldlen <- atomicModifyIORefCAS q $ \(es, n) ->         ((msg : es, n + 1), n)@@ -82,6 +89,7 @@  workerCollectLatency :: WorkerInfo -> IO (Maybe (Count, NanoSecond64)) workerCollectLatency winfo = do+    -- XXX make this unboxed IORef     (cnt0, t0) <- readIORef (workerLatencyStart winfo)     cnt1 <- readIORef (workerYieldCount winfo)     let cnt = cnt1 - cnt0@@ -129,12 +137,15 @@ -- Worker rate control ------------------------------------------------------------------------------- --- We either block, or send one worker with limited yield count or one or more--- workers with unlimited yield count.+-- | Describes how to pace the work based on current measurement estimates. If+-- the rate is higher than expected we may have to sleep for some time+-- ('BlockWait'), or send just one worker with limited yield count+-- ('PartialWorker') or send more than one workers with max yield count of each+-- limited to the total maximum target count. data Work-    = BlockWait NanoSecond64-    | PartialWorker Count-    | ManyWorkers Int Count+    = BlockWait NanoSecond64 -- ^ Sleep required before next dispatch+    | PartialWorker Count -- ^ One worker is enough, total yields needed+    | ManyWorkers Int Count -- ^ Worker count, total yields needed overall     deriving Show  -- | Another magic number! When we have to start more workers to cover up a@@ -145,10 +156,15 @@ rateRecoveryTime :: NanoSecond64 rateRecoveryTime = 1000000 --- | Get the worker latency without resetting workerPendingLatency--- Returns (total yield count, base time, measured latency) -- CAUTION! keep it in sync with collectLatency-getWorkerLatency :: YieldRateInfo -> IO (Count, AbsTime, NanoSecond64)++-- | Same as 'collectLatency' except that it does not update anything, this is+-- a readonly version of 'collectLatency'.+--+getWorkerLatency ::+       YieldRateInfo+    -> IO (Count, AbsTime, NanoSecond64)+    -- ^ (total yield count, base timestamp, 'workerMeasuredlatency') getWorkerLatency yinfo  = do     let cur      = workerPendingLatency yinfo         col      = workerCollectedLatency yinfo@@ -172,14 +188,24 @@     return (lcount + totalCount, ltime, newLat)  -- XXX we can use phantom types to distinguish the duration/latency/expectedLat+-- XXX This should probably be inlined.+-- XXX Move this to the common Types module, since this is used by both+-- dispatcher and workers.++-- | Estimate how many workers and yield count ('Work') is required to maintian+-- the target yield rate of the channel.+--+-- This is used by the worker dispatcher to estimate how many workers to+-- dispatch. It is also used periodically by the workers to decide whether to+-- stop or continue working. estimateWorkers-    :: Limit-    -> Count-    -> Count-    -> NanoSecond64-    -> NanoSecond64-    -> NanoSecond64-    -> LatencyRange+    :: Limit -- ^ Channel's max worker limit+    -> Count -- ^ Channel's yield count since start+    -> Count -- ^ 'svarGainedLostYields'+    -> NanoSecond64 -- ^ The up time of the channel+    -> NanoSecond64 -- ^ Current 'workerMeasuredLatency'+    -> NanoSecond64 -- ^ 'svarLatencyTarget'+    -> LatencyRange -- ^ 'svarLatencyRange'     -> Work estimateWorkers workerLimit svarYields gainLossYields                 svarElapsed wLatency targetLat range =@@ -194,7 +220,7 @@         -- When the workers are IO bound we can increase the throughput by         -- increasing the number of workers as long as the IO device has enough         -- capacity to process all the requests concurrently. If the IO-        -- bandwidth is saturated increasing the workers won't help. Also, if+        -- bandwidth is saturated, increasing the workers won't help. Also, if         -- the CPU utilization in processing all these requests exceeds the CPU         -- bandwidth, then increasing the number of workers won't help.         --@@ -253,7 +279,15 @@                 Unlimited -> n                 Limited x -> min n (fromIntegral x) -isBeyondMaxRate :: Limit -> IORef Int -> YieldRateInfo -> IO Bool+-- | Using the channel worker latency and channel yield count stats from the+-- current measurement interval, estimate how many workers are needed to+-- maintain the target rate and compare that with current number of workers.+-- Returns true if we have have more than required workers.+isBeyondMaxRate ::+       Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> YieldRateInfo -- ^ Channel's rate control info+    -> IO Bool -- ^ True if we are exceeding the specified rate isBeyondMaxRate workerLimit workerCount rateInfo = do     (count, tstamp, wLatency) <- getWorkerLatency rateInfo     now <- getTime Monotonic@@ -273,15 +307,19 @@ -- than based on the worker local yields as other workers may have yielded more -- and we should stop based on the aggregate yields. However, latency update -- period can be based on individual worker yields.-{-# NOINLINE checkRatePeriodic #-}-checkRatePeriodic ::++-- | Update the worker latency and check the channel yield rate. Updates and+-- checks only at specified multiples of yield count to keep the overhead low.+{-# NOINLINE updateLatencyAndCheckRate #-}+updateLatencyAndCheckRate ::        Limit     -> IORef Int     -> YieldRateInfo     -> WorkerInfo     -> Count     -> IO Bool-checkRatePeriodic workerLimit workerCount rateInfo workerInfo ycnt = do+updateLatencyAndCheckRate workerLimit workerCount rateInfo workerInfo ycnt = do+    -- XXX make this an unboxed IORef     i <- readIORef (workerPollingInterval rateInfo)     -- XXX use generation count to check if the interval has been updated     if i /= 0 && (ycnt `mod` i) == 0@@ -291,13 +329,22 @@         isBeyondMaxRate workerLimit workerCount rateInfo     else return False --- | CAUTION! this also updates the yield count and therefore should be called--- only when we are actually yielding an element.-{-# NOINLINE workerRateControl #-}-workerRateControl :: Limit -> IORef Int -> YieldRateInfo -> WorkerInfo -> IO Bool-workerRateControl workerLimit workerCount rateInfo workerInfo = do+-- | Update the local yield count of the worker and check if:+--+-- * the channel yield rate is beyond max limit+-- * worker's yield count is beyond max limit+--+{-# NOINLINE incrWorkerYieldCount #-}+incrWorkerYieldCount ::+       Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> YieldRateInfo -- ^ Channel's rate control info+    -> WorkerInfo -- ^ Worker's yield count info+    -> IO Bool -- ^ True means limits are ok and worker can continue+incrWorkerYieldCount workerLimit workerCount rateInfo workerInfo = do     cnt <- updateYieldCount workerInfo-    beyondMaxRate <- checkRatePeriodic workerLimit workerCount rateInfo workerInfo cnt+    beyondMaxRate <-+        updateLatencyAndCheckRate workerLimit workerCount rateInfo workerInfo cnt     return $ not (isBeyondMaxYield cnt workerInfo || beyondMaxRate)  -------------------------------------------------------------------------------@@ -308,21 +355,31 @@ -- streams. latency update must be done when we yield directly to outputQueue -- or when we yield to heap. --- | Returns whether the worker should continue (True) or stop (False).+-- | Add a 'ChildYield' event to the channel's output queue.+--+-- This is a wrapper over 'sendEvent', it does a few more things:+--+-- * performs a buffer limit check, returns False if exceeded+--+-- When rate control is enabled and 'WorkerInfo' is supplied::+--+-- * increments the worker yield count+-- * periodically pushes the worker latency stats to the channel+-- * performs a rate limit check, returns False if exceeded {-# INLINE sendYield #-} sendYield ::-       Limit-    -> Limit-    -> IORef Int-    -> Maybe WorkerInfo-    -> Maybe YieldRateInfo-    -> IORef ([ChildEvent a], Int)-    -> MVar ()-    -> ChildEvent a-    -> IO Bool-sendYield bufferLimit workerLimit workerCount workerInfo rateInfo q bell msg =+       Limit -- ^ Channel's max buffer limit+    -> Limit -- ^ Channel's max worker limit+    -> IORef Int -- ^ Current worker count+    -> Maybe YieldRateInfo -- ^ Channel's rate control info+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the output is added+    -> MVar () -- ^ Door bell to ring+    -> Maybe WorkerInfo -- ^ Worker's yield count info+    -> a -- ^ The output to be sent+    -> IO Bool -- ^ True means worker is allowed to continue working+sendYield bufferLimit workerLimit workerCount rateInfo q bell workerInfo msg =     do-    oldlen <- sendWithDoorBell q bell msg+    oldlen <- sendEvent q bell (ChildYield msg)     bufferSpaceOk <-         case bufferLimit of             Unlimited -> return True@@ -335,7 +392,7 @@                 case rateInfo of                     Nothing -> return True                     Just yinfo ->-                        workerRateControl workerLimit workerCount yinfo winfo+                        incrWorkerYieldCount workerLimit workerCount yinfo winfo             Nothing -> return True     return $ bufferSpaceOk && rateLimitOk @@ -349,27 +406,37 @@     i <- readIORef (workerPollingInterval info)     when (i /= 0) $ workerUpdateLatency info winfo +-- | Add a 'ChildStop' event to the channel's output queue. When rate control+-- is enabled, it pushes the worker latency stats to the channel. {-# INLINABLE sendStop #-} sendStop ::-       IORef Int-    -> Maybe WorkerInfo-    -> Maybe YieldRateInfo-    -> IORef ([ChildEvent a], Int)-    -> MVar ()+       IORef Int -- ^ Channel's current worker count+    -> Maybe YieldRateInfo -- ^ Channel's rate control info+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the stop event is added+    -> MVar () -- ^ Door bell to ring+    -> Maybe WorkerInfo -- ^ Worker's yield count info     -> IO ()-sendStop workerCount workerInfo rateInfo q bell = do+sendStop workerCount rateInfo q bell workerInfo = do     atomicModifyIORefCAS_ workerCount $ \n -> n - 1     case (workerInfo, rateInfo) of       (Just winfo, Just rinfo) ->           workerStopUpdate winfo rinfo       _ ->           return ()-    myThreadId >>= \tid ->-        void $ sendWithDoorBell q bell (ChildStop tid Nothing)+    tid <- myThreadId+    void $ sendEvent q bell (ChildStop tid Nothing) -{-# NOINLINE handleChildException #-}-handleChildException ::-    IORef ([ChildEvent a], Int) -> MVar () -> SomeException -> IO ()-handleChildException q bell e = do+-- XXX Shouldn't we perform a workerStopUpdate even in this case?++-- | Add a 'ChildStop' event with exception to the channel's output queue.+{-# NOINLINE sendException #-}+sendException ::+       IORef Int -- ^ Channel's current worker count+    -> IORef ([ChildEvent a], Int) -- ^ Queue where the event is added+    -> MVar () -- ^ Door bell to ring+    -> SomeException -- ^ The exception to send+    -> IO ()+sendException workerCount q bell e = do+    atomicModifyIORefCAS_ workerCount $ \n -> n - 1     tid <- myThreadId-    void $ sendWithDoorBell q bell (ChildStop tid (Just e))+    void $ sendEvent q bell (ChildStop tid (Just e))
− src/Streamly/Internal/Data/Fold/Async.hs 
@@ -1,133 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Fold.Async--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Fold.Async-    (-    -- * Trimming-      takeInterval--    -- * Splitting-    , intervalsOf-    )-where--import Control.Concurrent (threadDelay, forkIO, killThread)-import Control.Concurrent.MVar (MVar, newMVar, swapMVar, readMVar)-import Control.Exception (SomeException(..), catch, mask)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Data.Fold (many)-import Streamly.Internal.Data.Fold (Fold(..), Step (..))-import Streamly.Internal.Control.Concurrent (MonadAsync, withRunInIO)-import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))---- $setup--- >>> :m--- >>> :set -fno-warn-deprecations--- >>> :set -XFlexibleContexts--- >>> import qualified Streamly.Prelude as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Async as Fold---- XXX We can use asyncClock here. A parser can be used to return an input that--- arrives after the timeout.--- XXX If n is 0 return immediately in initial.--- XXX we should probably discard the input received after the timeout like--- takeEndBy_.---- XXX The foldMany doctest is important for consistency with the "many" fold,--- and intervalsOf. We should put it in tests.---- | @takeInterval n fold@ uses @fold@ to fold the input items arriving within--- a window of first @n@ seconds.------ >>> input = Stream.delay 0.2 $ Stream.fromList [1..10]--- >>> Stream.fold (Fold.takeInterval 1.0 Fold.toList) input--- [1,2,3,4,5,6]------ >>> f = Fold.takeInterval 0.5 Fold.toList--- >>> Stream.fold Fold.toList $ Stream.foldMany f input--- [[1,2,3,4],[5,6,7],[8,9,10]]------ Stops when @fold@ stops or when the timeout occurs. Note that the fold needs--- an input after the timeout to stop. For example, if no input is pushed to--- the fold until one hour after the timeout had occurred, then the fold will--- be done only after consuming that input.------ /Pre-release/----{-# INLINE takeInterval #-}-takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b-takeInterval n (Fold step initial done final) =-    Fold step' initial' done' final'--    where--    initial' = do-        res <- initial-        case res of-            Partial s -> do-                mv <- liftIO $ newMVar False-                t <--                    withRunInIO $ \run ->-                        mask $ \restore -> do-                            tid <--                                forkIO-                                  $ catch-                                        (restore $ void $ run (timerThread mv))-                                        (handleChildException mv)-                            run (return tid)-                return $ Partial $ Tuple3' s mv t-            Done b -> return $ Done b--    step' (Tuple3' s mv t) a = do-        val <- liftIO $ readMVar mv-        if val-        then do-            res <- step s a-            case res of-                Partial sres -> Done <$> final sres-                Done bres -> return $ Done bres-        else do-            res <- step s a-            case res of-                Partial fs -> return $ Partial $ Tuple3' fs mv t-                Done b -> liftIO (killThread t) >> return (Done b)--    done' (Tuple3' s _ _) = done s--    final' (Tuple3' s _ _) = final s--    timerThread mv = do-        liftIO $ threadDelay (round $ n * 1000000)-        -- Use IORef + CAS? instead of MVar since its a Bool?-        liftIO $ void $ swapMVar mv True--    handleChildException :: MVar Bool -> SomeException -> IO ()-    handleChildException mv _ = void $ swapMVar mv True---- For example, we can copy and distribute a stream to multiple folds where--- each fold can group the input differently e.g. by one second, one minute and--- one hour windows respectively and fold each resulting stream of folds.---- XXX This needs to be fixed like intervalsOf in Data.Stream.Time.---- | Group the input stream into windows of n second each using the first fold--- and then fold the resulting groups using the second fold.------ >>> intervals = Fold.intervalsOf 0.5 Fold.toList Fold.toList--- >>> Stream.fold intervals $ Stream.delay 0.2 $ Stream.fromList [1..10]--- [[1,2,3,4],[5,6,7],[8,9,10]]------ > intervalsOf n split = many (takeInterval n split)------ /Pre-release/----{-# INLINE intervalsOf #-}-intervalsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c-intervalsOf n split = many (takeInterval n split)
+ src/Streamly/Internal/Data/Fold/Channel.hs view
@@ -0,0 +1,15 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Channel+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Fold.Channel+    (+      module Streamly.Internal.Data.Fold.Channel.Type+    )+where++import Streamly.Internal.Data.Fold.Channel.Type
+ src/Streamly/Internal/Data/Fold/Channel/Type.hs view
@@ -0,0 +1,649 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Channel.Type+-- Copyright   : (c) 2017, 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Fold.Channel.Type+    (+    -- ** Type+      Channel (..)+    , OutEvent (..)++    -- ** Configuration+    , Config+    , defaultConfig+    , maxBuffer+    , boundThreads+    , inspect++    -- ** Operations+    , newChannelWith+    , newChannelWithScan+    , newChannel+    , newScanChannel+    , sendToWorker+    , sendToWorker_+    , checkFoldStatus -- XXX collectFoldOutput+    , dumpChannel+    , cleanup+    , finalize+    )+where++#include "inline.hs"++import Control.Concurrent (ThreadId, myThreadId, tryPutMVar)+import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar)+import Control.Exception (SomeException(..))+import Control.Monad (void, when)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.List (intersperse)+import Streamly.Internal.Control.Concurrent+    (MonadAsync, MonadRunInIO, askRunInIO)+import Streamly.Internal.Control.ForkLifted (doForkWith)+import Streamly.Internal.Data.Atomics (writeBarrier)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker (sendEvent)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as D++import Streamly.Internal.Data.Channel.Types++-- XXX We can make the fold evaluation concurrent by using a monoid for the+-- accumulator. It will then work in the same way as the stream evaluation, in+-- stream evaluation we dequeue the head and queue the tail, in folds we will+-- queue the accumulator and it will be picked by the next worker to accumulate+-- the next value.++data OutEvent b =+      FoldException ThreadId SomeException+    | FoldPartial b+    | FoldDone ThreadId b+    | FoldEOF ThreadId++-- | The fold driver thread queues the input of the fold in the 'inputQueue'+-- The driver rings the doorbell when the queue transitions from empty to+-- non-empty state.+--+-- The fold consumer thread dequeues the input items from the 'inputQueue' and+-- supplies them to the fold. When the fold is done the output of the fold is+-- placed in 'inputQueue' and 'outputDoorBell' is rung.+--+-- The fold driver thread keeps watching the 'outputQueue', if the fold has+-- terminated, it stops queueing the input to the 'inputQueue'+--+-- If the fold driver runs out of input it stops and waits for the fold to+-- drain the buffered input.+--+-- Driver thread ------>------Input Queue and Doorbell ----->-----Fold thread+--+-- Driver thread ------<------Output Queue and Doorbell-----<-----Fold thread+--+data Channel m a b = Channel+    {+    -- FORWARD FLOW: Flow of data from the driver to the consuming fold++    -- XXX Use a different type than ChildEvent. We can do with a simpler type+    -- in folds.++    -- | Input queue (messages, length).+    --+    -- [LOCKING] Frequent, locked access. Input is queued frequently by the+    -- driver and infrequently dequeued in chunks by the fold.+    --+      inputQueue :: IORef ([ChildEvent a], Int)++      -- | The maximum size of the inputQueue allowed.+    , maxInputBuffer :: Limit++    -- | Doorbell is rung by the driver when 'inputQueue' transitions from+    -- empty to non-empty.+    --+    -- [LOCKING] Infrequent, MVar.+    , inputItemDoorBell :: MVar ()+    , closedForInput :: IORef Bool++    -- | Doorbell to tell the driver that there is now space available in the+    -- 'inputQueue' and more items can be queued.+    , inputSpaceDoorBell :: MVar ()++    , readInputQ :: m [ChildEvent a]++    -- | Final output and exceptions, if any, queued by the fold and read by+    -- the fold driver.+    --+    -- [LOCKING] atomicModifyIORef. Output is queued infrequently by the fold+    -- and read frequently by the driver.+    , outputQueue :: IORef ([OutEvent b], Int)++    -- | Doorbell for the 'outputQueue', rung by the fold when the queue+    -- transitions from empty to non-empty.+    --+    -- [LOCKING] Infrequent, MVar.+    , outputDoorBell :: MVar ()++    -- cleanup: to track garbage collection of SVar --+    , svarRef :: Maybe (IORef ())++    -- Stats --+    , svarStats :: SVarStats++    -- Diagnostics --+    , svarInspectMode :: Bool+    , svarCreator :: ThreadId+    }++-------------------------------------------------------------------------------+-- Config+-------------------------------------------------------------------------------++-- | An abstract type for specifying the configuration parameters of a+-- 'Channel'. Use @Config -> Config@ modifier functions to modify the default+-- configuration. See the individual modifier documentation for default values.+--+data Config = Config+    {+      _bufferHigh :: Limit+    , _inspect    :: Bool+    , _bound :: Bool+    }++-------------------------------------------------------------------------------+-- State defaults and reset+-------------------------------------------------------------------------------++defaultMaxBuffer :: Limit+defaultMaxBuffer = Limited magicMaxBuffer++-- | The fields prefixed by an _ are not to be accessed or updated directly but+-- via smart accessor APIs. Use get/set routines instead of directly accessing+-- the Config fields+defaultConfig :: Config+defaultConfig = Config+    {+      _bufferHigh = defaultMaxBuffer+    , _inspect = False+    , _bound = False+    }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++-- | Specify the maximum size of the buffer for storing the results from+-- concurrent computations. If the buffer becomes full we stop spawning more+-- concurrent tasks until there is space in the buffer.+-- A value of 0 resets the buffer size to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)+-- coupled with an unbounded 'maxThreads' value is a recipe for disaster in+-- presence of infinite streams, or very large streams.  Especially, it must+-- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in+-- applicative zip streams generates an infinite stream causing unbounded+-- concurrent generation with no limit on the buffer or threads.+--+maxBuffer :: Int -> Config -> Config+maxBuffer n st =+    st { _bufferHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxBuffer+                 else Limited (fromIntegral n)+       }++getMaxBuffer :: Config -> Limit+getMaxBuffer = _bufferHigh++-- | Print debug information about the 'Channel' when the stream ends. When the+-- stream does not end normally, the channel debug information is printed when+-- the channel is garbage collected. If you are expecting but not seeing the+-- debug info try adding a 'performMajorGC' before the program ends.+--+inspect :: Bool -> Config -> Config+inspect flag st = st { _inspect = flag }++getInspectMode :: Config -> Bool+getInspectMode = _inspect++-- | Spawn bound threads (i.e., spawn threads using 'forkOS' instead of+-- 'forkIO'). The default value is 'False'.+--+-- Currently, this only takes effect only for concurrent folds.+boundThreads :: Bool -> Config -> Config+boundThreads flag st = st { _bound = flag }++getBound :: Config -> Bool+getBound = _bound++-------------------------------------------------------------------------------+-- Inspection+-------------------------------------------------------------------------------++-- | Dump the channel stats for diagnostics. Used when 'inspect' option is+-- enabled.+{-# NOINLINE dumpChannel #-}+dumpChannel :: Channel m a b -> IO String+dumpChannel sv = do+    xs <- sequence $ intersperse (return "\n")+        [ return (dumpCreator (svarCreator sv))+        , return "---------CURRENT STATE-----------"+        , dumpOutputQ (inputQueue sv)+        -- XXX print the types of events in the outputQueue, first 5+        , dumpDoorBell (inputItemDoorBell sv)+        , return "---------STATS-----------\n"+        , dumpSVarStats (svarInspectMode sv) Nothing (svarStats sv)+        ]+    return $ concat xs++-------------------------------------------------------------------------------+-- Support for running folds concurrently+-------------------------------------------------------------------------------++-- $concurrentFolds+--+-- To run folds concurrently, we need to decouple the fold execution from the+-- stream production. We use the SVar to do that, we have a single worker+-- pushing the stream elements to the SVar and on the consumer side a fold+-- driver pulls the values and folds them.+--+-- @+--+-- Fold worker <------Channel<------Fold driver+--     |  exceptions  |+--     --------------->+--+-- @+--+-- We need a channel for pushing exceptions from the fold worker to the fold+-- driver. The stream may be pushed to multiple folds at the same time. For+-- that we need one Channel per fold:+--+-- @+--+-- Fold worker <------Channel--+--                    |        |+-- Fold worker <------Channel------Driver+--                    |        |+-- Fold worker <------Channel--+--+-- @+--+-- Note: If the stream pusher terminates due to an exception, we do not+-- actively terminate the fold. It gets cleaned up by the GC.++-------------------------------------------------------------------------------+-- Process events received by a fold worker from a fold driver+-------------------------------------------------------------------------------++sendToDriver :: Channel m a b -> OutEvent b -> IO Int+sendToDriver sv msg = do+    -- In case the producer stream is blocked on pushing to the fold buffer+    -- then wake it up so that it can check for the stop event or exception+    -- being sent to it otherwise we will be deadlocked.+    -- void $ tryPutMVar (pushBufferMVar sv) ()+    sendEvent (outputQueue sv)+                     (outputDoorBell sv) msg++sendYieldToDriver :: MonadIO m => Channel m a b -> b -> m ()+sendYieldToDriver sv res = liftIO $ do+    tid <- myThreadId+    void $ sendToDriver sv (FoldDone tid res)++sendPartialToDriver :: MonadIO m => Channel m a b -> b -> m ()+sendPartialToDriver sv res = liftIO $ do+    void $ sendToDriver sv (FoldPartial res)++sendEOFToDriver :: MonadIO m => Channel m a b -> m ()+sendEOFToDriver sv = liftIO $ do+    tid <- myThreadId+    void $ sendToDriver sv (FoldEOF tid)++{-# NOINLINE sendExceptionToDriver #-}+sendExceptionToDriver :: Channel m a b -> SomeException -> IO ()+sendExceptionToDriver sv e = do+    tid <- myThreadId+    void $ sendToDriver sv (FoldException tid e)++data FromSVarState m a b =+      FromSVarRead (Channel m a b)+    | FromSVarLoop (Channel m a b) [ChildEvent a]++{-# INLINE_NORMAL fromInputQueue #-}+fromInputQueue :: MonadIO m => Channel m a b -> D.Stream m a+fromInputQueue svar = D.Stream step (FromSVarRead svar)++    where++    {-# INLINE_LATE step #-}+    step _ (FromSVarRead sv) = do+        list <- readInputQ sv+        -- Reversing the output is important to guarantee that we process the+        -- outputs in the same order as they were generated by the constituent+        -- streams.+        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)++    step _ (FromSVarLoop sv []) = return $ D.Skip $ FromSVarRead sv+    step _ (FromSVarLoop sv (ev : es)) = do+        case ev of+            -- XXX Separate input and output events. Input events cannot have+            -- Stop event and output events cannot have ChildStopChannel+            -- event.+            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)+            ChildStopChannel -> return D.Stop+            _ -> undefined++{-# INLINE readInputQChan #-}+readInputQChan :: Channel m a b -> IO ([ChildEvent a], Int)+readInputQChan chan = do+    let ss = if svarInspectMode chan then Just (svarStats chan) else Nothing+    r@(_, n) <- readOutputQRaw (inputQueue chan) ss+    if n <= 0+    then do+        liftIO+            $ withDiagMVar+                (svarInspectMode chan)+                (dumpChannel chan)+                "readInputQChan: nothing to do"+            $ takeMVar (inputItemDoorBell chan)+        readOutputQRaw (inputQueue chan) ss+    else return r++{-# INLINE readInputQWithDB #-}+readInputQWithDB :: Channel m a b -> IO ([ChildEvent a], Int)+readInputQWithDB chan = do+    r <- readInputQChan chan+    -- XXX We can do this only if needed, if someone sleeps because of buffer+    -- then they can set a flag and we ring the doorbell only if the flag is+    -- set. Like we do in sendWorkerWait for streams.+    _ <- tryPutMVar (inputSpaceDoorBell chan) ()+    return r++mkNewChannelWith :: forall m a b. MonadIO m =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> Config+    -> IO (Channel m a b)+mkNewChannelWith outQRev outQMvRev cfg = do+    outQ <- newIORef ([], 0)+    outQMv <- newEmptyMVar+    bufferMv <- newEmptyMVar+    ref <- newIORef False++    stats <- newSVarStats+    tid <- myThreadId++    let getSVar :: Channel m a b -> Channel m a b+        getSVar sv = Channel+            { inputQueue      = outQ+            , inputItemDoorBell   = outQMv+            , outputQueue = outQRev+            , outputDoorBell = outQMvRev+            , inputSpaceDoorBell = bufferMv+            , closedForInput = ref+            , maxInputBuffer   = getMaxBuffer cfg+            , readInputQ      = liftIO $ fmap fst (readInputQWithDB sv)+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv = getSVar sv in return sv++{-# INLINABLE newChannelWith #-}+{-# SPECIALIZE newChannelWith ::+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Fold IO a b+    -> IO (Channel IO a b, ThreadId) #-}+newChannelWith :: (MonadRunInIO m) =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Fold m a b+    -> m (Channel m a b, ThreadId)+newChannelWith outq outqDBell modifier f = do+    let config = modifier defaultConfig+    sv <- liftIO $ mkNewChannelWith outq outqDBell config+    mrun <- askRunInIO+    tid <- doForkWith+        (getBound config) (work sv) mrun (sendExceptionToDriver sv)+    return (sv, tid)++    where++    {-# NOINLINE work #-}+    work chan =+        let f1 = Fold.rmapM (void . sendYieldToDriver chan) f+         in D.fold f1 $ fromInputQueue chan++-- | Returns True if the fold terminated due to completion and False when due+-- to end-of-stream.+{-# INLINE scanToChannel #-}+scanToChannel :: MonadIO m => Channel m a b -> Scanl m a b -> Fold m a Bool+scanToChannel chan (Scanl step initial extract final) =+    Fold step1 initial1 extract1 final1++    where++    initial1 = do+        r <- initial+        case r of+            Fold.Partial s -> do+                b <- extract s+                void $ sendPartialToDriver chan b+                return $ Fold.Partial s+            Fold.Done b -> do+                sendYieldToDriver chan b+                return $ Fold.Done True++    step1 st x = do+        r <- step st x+        case r of+            Fold.Partial s -> do+                b <- extract s+                void $ sendPartialToDriver chan b+                return $ Fold.Partial s+            Fold.Done b -> do+                sendYieldToDriver chan b+                return $ Fold.Done True++    extract1 _ = error "extract: not supported by folds"++    -- XXX Should we not discard the result?+    final1 st = do+        void (final st)+        return False++{-# INLINABLE newChannelWithScan #-}+{-# SPECIALIZE newChannelWithScan ::+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Scanl IO a b+    -> IO (Channel IO a b, ThreadId) #-}+newChannelWithScan :: (MonadRunInIO m) =>+       IORef ([OutEvent b], Int)+    -> MVar ()+    -> (Config -> Config)+    -> Scanl m a b+    -> m (Channel m a b, ThreadId)+newChannelWithScan outq outqDBell modifier f = do+    let config = modifier defaultConfig+    sv <- liftIO $ mkNewChannelWith outq outqDBell config+    mrun <- askRunInIO+    tid <- doForkWith+        (getBound config) (work sv) mrun (sendExceptionToDriver sv)+    return (sv, tid)++    where++    {-# NOINLINE work #-}+    work chan = do+        completed <- D.fold (scanToChannel chan f) (fromInputQueue chan)+        -- We check for only one item in the outputqueue, for example in+        -- parTeeWith, multiple messages can make that complicated. Therefore,+        -- we first check if we already sent a FoldDone.+        when (not completed) $ sendEOFToDriver chan+        liftIO $ writeIORef (closedForInput chan) True+        liftIO writeBarrier+        void $ liftIO $ tryPutMVar (inputSpaceDoorBell chan) ()++{-# INLINABLE newChannel #-}+{-# SPECIALIZE newChannel ::+    (Config -> Config) -> Fold IO a b -> IO (Channel IO a b) #-}+newChannel :: (MonadRunInIO m) =>+    (Config -> Config) -> Fold m a b -> m (Channel m a b)+newChannel modifier f = do+    outQRev <- liftIO $ newIORef ([], 0)+    outQMvRev <- liftIO newEmptyMVar+    fmap fst (newChannelWith outQRev outQMvRev modifier f)++{-# INLINABLE newScanChannel #-}+{-# SPECIALIZE newScanChannel ::+    (Config -> Config) -> Scanl IO a b -> IO (Channel IO a b) #-}+newScanChannel :: (MonadRunInIO m) =>+    (Config -> Config) -> Scanl m a b -> m (Channel m a b)+newScanChannel modifier f = do+    outQRev <- liftIO $ newIORef ([], 0)+    outQMvRev <- liftIO newEmptyMVar+    fmap fst (newChannelWithScan outQRev outQMvRev modifier f)++-------------------------------------------------------------------------------+-- Process events received by the driver thread from the fold worker side+-------------------------------------------------------------------------------++-- XXX currently only one event is sent by a fold consumer to the stream+-- producer. But we can potentially have multiple events e.g. the fold step can+-- generate exception more than once and the producer can ignore those+-- exceptions or handle them and still keep driving the fold.++-- XXX In case of scan this could be a stream.++-- | Poll for events sent by the fold worker to the fold driver. The fold+-- consumer can send a "Stop" event or an exception. When a "Stop" is received+-- this function returns 'True'. If an exception is recieved then it throws the+-- exception.+--+{-# NOINLINE checkFoldStatus #-}+checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)+checkFoldStatus sv = do+    (list, _) <- liftIO $ readOutputQBasic (outputQueue sv)+    -- Reversing the output is important to guarantee that we process the+    -- outputs in the same order as they were generated by the constituent+    -- streams.+    processEvents $ reverse list++    where++    {-# INLINE processEvents #-}+    processEvents [] = return Nothing+    processEvents (ev : _) = do+        case ev of+            FoldException _ e -> throwM e+            FoldDone _ b -> return (Just b)+            FoldPartial _ ->+                error "checkFoldStatus: FoldPartial can occur only for scans"+            FoldEOF _ ->+                error "checkFoldStatus: FoldEOF can occur only for scans"++{-# INLINE isBufferAvailable #-}+isBufferAvailable :: MonadIO m => Channel m a b -> m Bool+isBufferAvailable sv = do+    let limit = maxInputBuffer sv+    case limit of+        Unlimited -> return True+        Limited lim -> do+            (_, n) <- liftIO $ readIORef (inputQueue sv)+            return $ fromIntegral lim > n++-- | Push values from a driver to a fold worker via a Channel. Blocks if no+-- space is available in the buffer. Before pushing a value to the Channel it+-- polls for events received from the fold worker.  If a stop event is received+-- then it returns 'True' otherwise false.  Propagates exceptions received from+-- the fold worker.+--+{-# INLINE sendToWorker #-}+sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)+sendToWorker chan a = go++    where++    -- Recursive function, should we use SPEC?+    go = do+        let qref = outputQueue chan+        status <- do+            (_, n) <- liftIO $ readIORef qref+            if n > 0+            then checkFoldStatus chan+            else return Nothing+        case status of+            Just _ -> return status+            Nothing -> do+                    r <- isBufferAvailable chan+                    if r+                    then do+                        liftIO+                            $ void+                            $ sendEvent+                                (inputQueue chan)+                                (inputItemDoorBell chan)+                                (ChildYield a)+                        return Nothing+                    else do+                        () <- liftIO $ takeMVar (inputSpaceDoorBell chan)+                        go++-- | Like sendToWorker but only sends, does not receive any events from the+-- fold.+{-# INLINE sendToWorker_ #-}+sendToWorker_ :: MonadAsync m => Channel m a b -> a -> m ()+sendToWorker_ chan a = go++    where++    -- Recursive function, should we use SPEC?+    go = do+        r <- isBufferAvailable chan+        if r+        then do+            liftIO+                $ void+                $ sendEvent+                    (inputQueue chan)+                    (inputItemDoorBell chan)+                    (ChildYield a)+        else do+            -- Block for space+            () <- liftIO $ takeMVar (inputSpaceDoorBell chan)+            closed <- liftIO $ readIORef (closedForInput chan)+            when (not closed) go++-- XXX Cleanup the fold if the stream is interrupted. Add a GC hook.++cleanup :: MonadIO m => Channel m a b -> m ()+cleanup chan = do+    when (svarInspectMode chan) $ liftIO $ do+        t <- getTime Monotonic+        writeIORef (svarStopTime (svarStats chan)) (Just t)+        printSVar (dumpChannel chan) "Scan channel done"++finalize :: MonadIO m => Channel m a b -> m ()+finalize chan = do+    liftIO $ void+        $ sendEvent+            (inputQueue chan)+            (inputItemDoorBell chan)+            ChildStopChannel
src/Streamly/Internal/Data/Fold/Concurrent.hs view
@@ -6,43 +6,40 @@ -- Stability   : experimental -- Portability : GHC ----- Using 'parEval' a fold can be decoupled from the driver and evaluated+-- = Asynchronous Evaluation+--+-- Using 'parBuffered' a fold can be decoupled from the driver and evaluated -- concurrently with the driver. The driver just pushes an element to the -- fold's buffer and waits for async evaluation to finish. ----- Avoid scanning a stream using a concurrent fold. When scanning a stream--- using a concurrent fold we need to keep in mind that the result of the scan--- may be delayed because of the asynchronous execution. The results may not be--- same as in the case of a synchronous fold.+-- Stages in a fold pipeline can be made concurrent using 'parBuffered'. ----- Stages in a fold pipeline can be made concurrent using 'parEval'.+-- = Concurrent Fold Combinators ----- The 'demux' combinator can be made concurrent by using 'parEval' on the fold+-- The 'demux' combinator can be made concurrent by using 'parBuffered' on the fold -- returned by the fold-generating function. Thus, we can fold values for each -- key in the input stream concurrently. ----- Similarly, we can use 'parEval' with other cobminators like 'toMap',+-- Similarly, we can use 'parBuffered' with other cobminators like 'toMap', -- 'demuxToMap', 'classify', 'tee', 'distribute', 'partition' etc. Basically, -- any combinator that composes multiple folds or multiple instances of a fold -- is a good candidate for running folds concurrently.---- TODO: ----- Before a fold returns "done" it has to drain the child folds. For example,--- consider a "take" operation on a `parEval` fold, the take would return as--- soon as it has taken required number of elements irrespective of whether the--- child fold has yet finished or not.+-- = Finalization ----- parLmapM on a fold.+-- Before a fold returns "done" it has to drain the child folds. For example,+-- consider a "take" operation on a `parBuffered` fold, the take should return as+-- soon as it has taken required number of elements but we have to ensure that+-- any asynchronous child folds finish before it returns. This is achieved by+-- calling the "final" operation of the fold.++-- = TODO -- -- Use multiple worker folds to fold serial chunks of a stream and collect the -- results using another fold, combine using a monoid. The results can be -- collected out-of-order or in-order. This would be easier if each input--- element is a streamable chunk and each fold consumes one at a time. This is--- like parConcatMap in streams. We also need to have a lconcatMap to expand--- the chunks in the input to streams before folding. This will require an--- input Skip constructor. In fact, parLmapM would be implemented in terms of--- this like in streams.+-- element is a streamable chunk and each fold consumes one chunk at a time.+-- This is like parConcatMap in streams. -- -- Concurrent append: if one fold's buffer becomes full then use the next one -- Concurrent interleave/partition: Round robin to n folds.@@ -50,8 +47,547 @@  module Streamly.Internal.Data.Fold.Concurrent     (-      module Streamly.Internal.Data.Fold.Concurrent.Channel+      parBuffered+    , parLmapM+    , parTeeWith+    , parTee+    , parDistribute+    , parPartition+    , parUnzipWithM+    , parUnzip+    , parDistributeScan+    , parDemuxScan++    -- Deprecated+    , parEval     ) where -import Streamly.Internal.Data.Fold.Concurrent.Channel+#include "inline.hs"+#include "deprecation.h"++import Control.Concurrent (newEmptyMVar, takeMVar, throwTo)+import Control.Monad.Catch (throwM)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (newIORef, readIORef)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Channel.Worker (sendEvent)+import Streamly.Internal.Data.Fold (Fold(..), Step (..))+import Streamly.Internal.Data.Stream (Stream(..), Step(..))+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Fold as Fold++import Streamly.Internal.Data.Fold.Channel.Type+import Streamly.Internal.Data.Channel.Types++-- $setup+-- >>> :set -fno-warn-deprecations+-- >>> import Control.Concurrent (threadDelay)+-- >>> import qualified Streamly.Internal.Data.Stream as Stream+-- >>> import qualified Streamly.Internal.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Fold.Concurrent as Fold++-------------------------------------------------------------------------------+-- Evaluating a Fold+-------------------------------------------------------------------------------++-- | 'parBuffered' introduces a concurrent stage at the input of the fold. The+-- inputs are asynchronously queued in a buffer and evaluated concurrently with+-- the evaluation of the source stream. On finalization, 'parBuffered' waits for+-- the asynchronous fold to complete before it returns.+--+-- In the following example both the stream and the fold have a 1 second delay,+-- but the delay is not compounded because both run concurrently.+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+--+-- >>> src = Stream.delay 1 (Stream.enumerateFromTo 1 3)+-- >>> dst = Fold.parBuffered id (Fold.lmapM delay Fold.sum)+-- >>> Stream.fold dst src+-- ...+--+-- Another example:+--+-- >>> Stream.toList $ Stream.groupsOf 4 dst src+-- ...+--+{-# INLINABLE parBuffered #-}+parBuffered, parEval+    :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b+parBuffered modifier f =+    Fold step initial extract final++    where++    -- XXX Supply an output channel to the fold. The fold would send the result+    -- from each step (i.e. scan result) to the channel. The Partial and Done+    -- constructors are sent to the channel. We then draw the resulting stream+    -- from that channel. Kind of concurrrent mapping on the stream but with a+    -- fold/scan.+    --+    -- There can also be a model where multiple folds pick input from the same+    -- channel.+    --+    -- We can also run parsers this way. So instead of sending output on each+    -- step it can send once it is done.+    initial = Partial <$> newChannel modifier f++    -- XXX This is not truly asynchronous. If the fold is done we only get to+    -- know when we send the next input unless the stream ends. We could+    -- potentially throw an async exception to the driver to inform it+    -- asynchronously. Alternatively, the stream should not block forever, it+    -- should keep polling the fold status. We can insert a timer tick in the+    -- input stream to do that.+    --+    -- A polled stream abstraction may be useful, it would consist of normal+    -- events and tick events, latter are guaranteed to arrive.+    --+    -- XXX We can use the config to indicate if the fold is a scanning type or+    -- one-shot, or use a separate parBufferedScan for scanning. For a scanning+    -- type fold the worker would always send the intermediate values back to+    -- the driver. An intermediate value can be returned on an input, or the+    -- driver can poll even without input, if we have the Skip input support.+    -- When the buffer is full we can return "Skip" and then the next step+    -- without input can wait for an output to arrive. Similarly, when "final"+    -- is called it can return "Skip" to continue or "Done" to indicate+    -- termination.+    step chan a = do+        status <- sendToWorker chan a+        return $ case status of+            Nothing -> Partial chan+            Just b -> Done b++    extract _ = error "Concurrent folds do not support scanning"++    -- XXX depending on the use case we may want to either wait for the result+    -- or cancel the ongoing work. We can use the config to control that?+    -- Currently it waits for the work to complete.+    final chan = do+        liftIO $ void+            $ sendEvent+                (inputQueue chan)+                (inputItemDoorBell chan)+                ChildStopChannel+        status <- checkFoldStatus chan+        case status of+            Nothing -> do+                liftIO+                    $ withDiagMVar+                        (svarInspectMode chan)+                        (dumpChannel chan)+                        "parBuffered: waiting to drain"+                    $ takeMVar (outputDoorBell chan)+                -- XXX remove recursion+                final chan+            Just b -> do+                cleanup chan+                return b+RENAME(parEval,parBuffered)++-- XXX We can have a lconcatMap (unfoldMany) to expand the chunks in the input+-- to streams before folding. This will require an input Skip constructor. In+-- fact, parLmapM can be implemented in terms of this like in streams.++-- | Evaluate the mapped actions concurrently with respect to each other. The+-- results may be unordered or ordered depending on the configuration.+--+-- /Unimplemented/+{-# INLINABLE parLmapM #-}+parLmapM :: -- MonadAsync m =>+    (Config -> Config) -> (a -> m b) -> Fold m b r -> Fold m a r+parLmapM = undefined++-- | Execute both the folds in a tee concurrently.+--+-- Definition:+--+-- >>> parTeeWith cfg f c1 c2 = Fold.teeWith f (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.length+-- >>> dst = Fold.parTeeWith id (,) c1 c2+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parTeeWith #-}+parTeeWith :: MonadAsync m =>+       (Config -> Config)+    -> (a -> b -> c)+    -> Fold m x a+    -> Fold m x b+    -> Fold m x c+parTeeWith cfg f c1 c2 = Fold.teeWith f (parBuffered cfg c1) (parBuffered cfg c2)++-- | Execute both the folds in a tee concurrently.+--+-- Definition:+--+-- >>> parTee cfg c1 c2 = Fold.teeWith (,) (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.length+-- >>> dst = Fold.parTee id c1 c2+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parTee #-}+parTee :: MonadAsync m =>+       (Config -> Config)+    -> Fold m x a+    -> Fold m x b+    -> Fold m x (a, b)+parTee cfg c1 c2 = Fold.teeWith (,) (parBuffered cfg c1) (parBuffered cfg c2)++-- | Distribute the input to all the folds in the supplied list concurrently.+--+-- Definition:+--+-- >>> parDistribute cfg = Fold.distribute . fmap (Fold.parBuffered cfg)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parDistribute id [c,c,c]+-- >>> Stream.fold dst src+-- ...+--+{-# INLINABLE parDistribute #-}+parDistribute :: MonadAsync m =>+    (Config -> Config) -> [Fold m a b] -> Fold m a [b]+parDistribute cfg = Fold.distribute . fmap (parBuffered cfg)++-- | Select first fold for Left input and second for Right input. Both folds+-- run concurrently.+--+-- Definition+--+-- >>> parPartition cfg c1 c2 = Fold.partition (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parPartition id c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> if even x then Left x else Right x)) src+-- ...+--+{-# INLINABLE parPartition #-}+parPartition :: MonadAsync m =>+    (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+parPartition cfg c1 c2 = Fold.partition (parBuffered cfg c1) (parBuffered cfg c2)++-- | Split and distribute the output to two different folds and then zip the+-- results. Both the consumer folds run concurrently.+--+-- Definition+--+-- >>> parUnzipWithM cfg f c1 c2 = Fold.unzipWithM f (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parUnzipWithM id (pure . id) c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> (x, x* x))) src+-- ...+--+{-# INLINABLE parUnzipWithM #-}+parUnzipWithM :: MonadAsync m+    => (Config -> Config) -> (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+parUnzipWithM cfg f c1 c2 = Fold.unzipWithM f (parBuffered cfg c1) (parBuffered cfg c2)++-- | Split and distribute the output to two different folds and then zip the+-- results. Both the consumer folds run concurrently.+--+-- Definition+--+-- >>> parUnzip cfg c1 c2 = Fold.unzip (Fold.parBuffered cfg c1) (Fold.parBuffered cfg c2)+--+-- Example:+--+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Fold.lmapM delay Fold.sum+-- >>> c2 = Fold.lmapM delay Fold.sum+-- >>> dst = Fold.parUnzip id c1 c2+-- >>> Stream.fold dst $ (fmap (\x -> (x, x * x))) src+-- ...+--+{-# INLINABLE parUnzip #-}+parUnzip :: MonadAsync m+    => (Config -> Config) -> Fold m b x -> Fold m c y -> Fold m (b,c) (x,y)+parUnzip cfg c1 c2 = Fold.unzip (parBuffered cfg c1) (parBuffered cfg c2)++-- There are two ways to implement a concurrent scan.+--+-- 1. Make the scan itself asynchronous, add the input to the queue, and then+-- extract the output. Extraction will have to be asynchronous, which will+-- require changes to the scan driver. This will require a different Scanl+-- type.+--+-- 2. A monolithic implementation of concurrent Stream->Stream scan, using a+-- custom implementation of the scan and the driver.++{-# ANN type ScanState Fuse #-}+data ScanState s q db f =+      ScanInit+    | ScanGo s q db [f]+    | ScanDrain q db [f]+    | ScanStop++-- XXX return [b] or just b?+-- XXX We can use a one way mailbox type abstraction instead of using an IORef+-- for adding new folds dynamically.++-- | Evaluate a stream and send its outputs to zero or more dynamically+-- generated folds. It checks for any new folds at each input generation step.+-- Any new fold is added to the list of folds which are currently running. If+-- there are no folds available, the input is discarded. If a fold completes+-- its output is emitted in the output of the scan.+--+-- >>> import Data.IORef+-- >>> ref <- newIORef [Fold.take 2 Fold.sum, Fold.take 2 Fold.length :: Fold.Fold IO Int Int]+-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))+-- >>> Stream.toList $ Fold.parDistributeScan id gen (Stream.enumerateFromTo 1 10)+-- ...+--+{-# INLINE parDistributeScan #-}+parDistributeScan :: MonadAsync m =>+    (Config -> Config) -> m [Fold m a b] -> Stream m a -> Stream m [b]+parDistributeScan cfg getFolds (Stream sstep state) =+    Stream step ScanInit++    where++    -- XXX can be written as a fold+    processOutputs chans events done = do+        case events of+            [] -> return (chans, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone tid b ->+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs (b:done)+                    FoldPartial _ ->+                        error "parDistributeScan: cannot occur for folds"+                    FoldEOF _ ->+                        error+                            "parDistributeScan: FoldEOF cannot occur for folds"++    collectOutputs qref chans = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs chans r []+        else return (chans, [])++    step _ ScanInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (ScanGo state q db [])++    step gst (ScanGo st q db chans) = do+        -- merge any new channels added since last input+        fxs <- getFolds+        newChans <- Prelude.mapM (newChannelWith q db cfg) fxs+        let allChans = chans ++ newChans++        -- Collect outputs from running channels+        (running, outputs) <- collectOutputs q allChans++        -- Send input to running folds+        res <- sstep (adaptState gst) st+        next <- case res of+            Yield x s -> do+                -- XXX We might block forever if some folds are already+                -- done but we have not read the output queue yet. To+                -- avoid that we have to either (1) precheck if space+                -- is available in the input queues of all folds so+                -- that this does not block, or (2) we have to use a+                -- non-blocking read and track progress so that we can+                -- restart from where we left.+                --+                -- If there is no space available then we should block+                -- on doorbell db or inputSpaceDoorBell of the relevant+                -- channel. To avoid deadlock the output space can be+                -- kept unlimited. However, the blocking will delay the+                -- processing of outputs. We should yield the outputs+                -- before blocking.+                Prelude.mapM_ (`sendToWorker_` x) (fmap fst running)+                return $ ScanGo s q db running+            Skip s -> do+                return $ ScanGo s q db running+            Stop -> do+                Prelude.mapM_ finalize (fmap fst running)+                return $ ScanDrain q db running+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (ScanDrain q db chans) = do+        (running, outputs) <- collectOutputs q chans+        case running of+            [] -> return $ Yield outputs ScanStop+            _ -> do+                if null outputs+                then do+                    liftIO $ takeMVar db+                    return $ Skip (ScanDrain q db running)+                else return $ Yield outputs (ScanDrain q db running)+    step _ ScanStop = return Stop++{-# ANN type DemuxState Fuse #-}+data DemuxState s q db f =+      DemuxInit+    | DemuxGo s q db f+    | DemuxDrain q db f+    | DemuxStop++-- XXX We need to either (1) remember a key when done so that we do not add the+-- fold again because some inputs would be lost in between, or (2) have a+-- FoldYield constructor to yield repeatedly so that we can restart the+-- existing fold itself when it is done. But in that case we cannot change the+-- fold once it is started. Also the Map would keep on increasing in size as we+-- never delete a key. Whatever we do we should keep the non-concurrent fold as+-- well consistent with that.++-- | Evaluate a stream and send its outputs to the selected fold. The fold is+-- dynamically selected using a key at the time of the first input seen for+-- that key. Any new fold is added to the list of folds which are currently+-- running. If there are no folds available for a given key, the input is+-- discarded. If a fold completes its output is emitted in the output of the+-- scan.+--+-- >>> import qualified Data.Map.Strict as Map+-- >>> import Data.Maybe (fromJust)+-- >>> f1 = ("even", Fold.take 2 Fold.sum)+-- >>> f2 = ("odd", Fold.take 2 Fold.sum)+-- >>> kv = Map.fromList [f1, f2]+-- >>> getFold k = return (fromJust $ Map.lookup k kv)+-- >>> getKey x = if even x then "even" else "odd"+-- >>> input = Stream.enumerateFromTo 1 10+-- >>> Stream.toList $ Fold.parDemuxScan id getKey getFold input+-- ...+--+{-# INLINE parDemuxScan #-}+parDemuxScan :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> m (Fold m a b))+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScan cfg getKey getFold (Stream sstep state) =+    Stream step DemuxInit++    where++    -- XXX can be written as a fold+    processOutputs keyToChan events done = do+        case events of+            [] -> return (keyToChan, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        let chans = fmap snd $ Map.toList keyToChan+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone _tid o@(k, _) ->+                        let ch = Map.delete k keyToChan+                         in processOutputs ch xs (o:done)+                    FoldPartial _ ->+                        error "parDemuxScan: cannot occur for folds"+                    FoldEOF _ ->+                        error "parDemuxScan: FoldEOF cannot occur for folds"++    collectOutputs qref keyToChan = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs keyToChan r []+        else return (keyToChan, [])++    step _ DemuxInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (DemuxGo state q db Map.empty)++    step gst (DemuxGo st q db keyToChan) = do+        -- Collect outputs from running channels+        (keyToChan1, outputs) <- collectOutputs q keyToChan++        -- Send input to the selected fold+        res <- sstep (adaptState gst) st++        next <- case res of+            Yield x s -> do+                -- XXX If the fold for a particular key is done and we see that+                -- key again. If we have not yet collected the done event we+                -- cannot restart the fold because the previous key is already+                -- installed. Thererfore, restarting the fold for the same key+                -- fraught with races.+                let k = getKey x+                (keyToChan2, ch) <-+                    case Map.lookup k keyToChan1 of+                        Nothing -> do+                            fld <- getFold k+                            r@(chan, _) <- newChannelWith q db cfg (fmap (k,) fld)+                            return (Map.insert k r keyToChan1, chan)+                        Just (chan, _) -> return (keyToChan1, chan)+                -- XXX We might block forever if some folds are already+                -- done but we have not read the output queue yet. To+                -- avoid that we have to either (1) precheck if space+                -- is available in the input queues of all folds so+                -- that this does not block, or (2) we have to use a+                -- non-blocking read and track progress so that we can+                -- restart from where we left.+                --+                -- If there is no space available then we should block+                -- on doorbell db or inputSpaceDoorBell of the relevant+                -- channel. To avoid deadlock the output space can be+                -- kept unlimited. However, the blocking will delay the+                -- processing of outputs. We should yield the outputs+                -- before blocking.+                sendToWorker_ ch x+                return $ DemuxGo s q db keyToChan2+            Skip s ->+                return $ DemuxGo s q db keyToChan1+            Stop -> do+                let chans = fmap (fst . snd) $ Map.toList keyToChan1+                Prelude.mapM_ finalize chans+                return $ DemuxDrain q db keyToChan1+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (DemuxDrain q db keyToChan) = do+        (keyToChan1, outputs) <- collectOutputs q keyToChan+        if Map.null keyToChan1+        -- XXX null outputs case+        then return $ Yield outputs DemuxStop+        else do+            if null outputs+            then do+                liftIO $ takeMVar db+                return $ Skip (DemuxDrain q db keyToChan1)+            else return $ Yield outputs (DemuxDrain q db keyToChan1)+    step _ DemuxStop = return Stop
− src/Streamly/Internal/Data/Fold/Concurrent/Channel.hs 
@@ -1,112 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Fold.Concurrent.Channel--- Copyright   : (c) 2022 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Fold.Concurrent.Channel-    (-    module Streamly.Internal.Data.Fold.Concurrent.Channel.Type--    -- * Configuration-    , maxBuffer-    , boundThreads-    , inspect--    -- * Fold operations-    , parEval-    )-where--import Control.Concurrent (takeMVar)-import Control.Monad (void, when)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.IORef (writeIORef)-import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Fold (Fold(..), Step (..))-import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)--import Streamly.Internal.Data.Fold.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Types------------------------------------------------------------------------------------ Evaluating a Fold------------------------------------------------------------------------------------ XXX Cleanup the fold if the stream is interrupted. Add a GC hook.---- | Evaluate a fold asynchronously using a concurrent channel. The driver just--- queues the input stream values to the fold channel buffer and returns. The--- fold evaluates the queued values asynchronously. On finalization, 'parEval'--- waits for the asynchronous fold to complete before it returns.----{-# INLINABLE parEval #-}-parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b-parEval modifier f =-    Fold step initial extract final--    where--    initial = Partial <$> newChannel modifier f--    -- XXX This is not truly asynchronous. If the fold is done we only get to-    -- know when we send the next input unless the stream ends. We could-    -- potentially throw an async exception to the driver to inform it-    -- asynchronously. Alternatively, the stream should not block forever, it-    -- should keep polling the fold status. We can insert a timer tick in the-    -- input stream to do that.-    ---    -- A polled stream abstraction may be useful, it would consist of normal-    -- events and tick events, latter are guaranteed to arrive.-    ---    -- XXX We can use the config to indicate if the fold is a scanning type or-    -- one-shot, or use a separate parEvalScan for scanning. For a scanning-    -- type fold the worker would always send the intermediate values back to-    -- the driver. An intermediate value can be returned on an input, or the-    -- driver can poll even without input, if we have the Skip input support.-    -- When the buffer is full we can return "Skip" and then the next step-    -- without input can wait for an output to arrive. Similarly, when "final"-    -- is called it can return "Skip" to continue or "Done" to indicate-    -- termination.-    step chan a = do-        status <- sendToWorker chan a-        return $ case status of-            Nothing -> Partial chan-            Just b -> Done b--    -- XXX We can use a separate type for non-scanning folds that will-    -- introduce a lot of complexity. Are there combinators that rely on the-    -- "extract" function even in non-scanning use cases?-    -- Instead of making such folds partial we can also make them return a-    -- Maybe type.-    extract _ = error "Concurrent folds do not support scanning"--    -- XXX depending on the use case we may want to either wait for the result-    -- or cancel the ongoing work. We can use the config to control that?-    -- Currently it waits for the work to complete.-    final chan = do-        liftIO $ void-            $ sendWithDoorBell-                (outputQueue chan)-                (outputDoorBell chan)-                ChildStopChannel-        status <- checkFoldStatus chan-        case status of-            Nothing -> do-                liftIO-                    $ withDiagMVar-                        (svarInspectMode chan)-                        (dumpSVar chan)-                        "parEval: waiting to drain"-                    $ takeMVar (outputDoorBellFromConsumer chan)-                -- XXX remove recursion-                final chan-            Just b -> do-                when (svarInspectMode chan) $ liftIO $ do-                    t <- getTime Monotonic-                    writeIORef (svarStopTime (svarStats chan)) (Just t)-                    printSVar (dumpSVar chan) "SVar Done"-                return b
− src/Streamly/Internal/Data/Fold/Concurrent/Channel/Type.hs 
@@ -1,331 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Fold.Concurrent.Channel.Type--- Copyright   : (c) 2017, 2022 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Fold.Concurrent.Channel.Type-    ( Channel (..)-    , newChannel-    , Config-    , sendToWorker-    , checkFoldStatus-    , dumpSVar-    )-where--#include "inline.hs"--import Control.Concurrent (ThreadId, myThreadId, tryPutMVar)-import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar)-import Control.Exception (SomeException(..))-import Control.Monad (void)-import Control.Monad.Catch (throwM)-import Control.Monad.IO.Class (MonadIO(..))-import Data.IORef (IORef, newIORef, readIORef)-import Data.List (intersperse)-import Streamly.Internal.Control.Concurrent-    (MonadAsync, MonadRunInIO, askRunInIO)-import Streamly.Internal.Control.ForkLifted (doForkWith)-import Streamly.Internal.Data.Fold (Fold(..))-import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)-import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell)--import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream as D--import Streamly.Internal.Data.Channel.Types--data Channel m a b = Channel-    {-    -- FORWARD FLOW: Flow of data from the driver to the consuming fold--    -- XXX This is inputQueue instead.--    -- Shared output queue (events, length)-    ---    -- [LOCKING] Frequent locked access. This is updated by the driver on each-    -- yield and once in a while read by the consumer fold thread.-    ---    -- XXX Use a different type than ChildEvent. We can do with a simpler type-    -- in folds.-      outputQueue :: IORef ([ChildEvent a], Int)-    -- This is capped to maxBufferLimit if set to more than that. Otherwise-    -- potentially each worker may yield one value to the buffer in the worst-    -- case exceeding the requested buffer size.-    , maxBufferLimit :: Limit--    -- [LOCKING] Infrequent MVar. Used when the outputQ transitions from empty-    -- to non-empty.-    , outputDoorBell :: MVar ()  -- signal the consumer about output-    , readOutputQ :: m [ChildEvent a]--    -- receive async events from the fold consumer to the driver.-    , outputQueueFromConsumer :: IORef ([ChildEvent b], Int)-    , outputDoorBellFromConsumer :: MVar ()-    , bufferSpaceDoorBell :: MVar ()--    -- cleanup: to track garbage collection of SVar ---    , svarRef :: Maybe (IORef ())--    -- Stats ---    , svarStats :: SVarStats--    -- Diagnostics ---    , svarInspectMode :: Bool-    , svarCreator :: ThreadId-    }--{-# NOINLINE dumpSVar #-}-dumpSVar :: Channel m a b -> IO String-dumpSVar sv = do-    xs <- sequence $ intersperse (return "\n")-        [ return (dumpCreator (svarCreator sv))-        , return "---------CURRENT STATE-----------"-        , dumpOutputQ (outputQueue sv)-        -- XXX print the types of events in the outputQueue, first 5-        , dumpDoorBell (outputDoorBell sv)-        , return "---------STATS-----------\n"-        , dumpSVarStats (svarInspectMode sv) Nothing (svarStats sv)-        ]-    return $ concat xs------------------------------------------------------------------------------------ Support for running folds concurrently------------------------------------------------------------------------------------ $concurrentFolds------ To run folds concurrently, we need to decouple the fold execution from the--- stream production. We use the SVar to do that, we have a single worker--- pushing the stream elements to the SVar and on the consumer side a fold--- driver pulls the values and folds them.------ @------ Fold worker <------Channel<------Fold driver---     |  exceptions  |---     --------------->------ @------ We need a channel for pushing exceptions from the fold worker to the fold--- driver. The stream may be pushed to multiple folds at the same time. For--- that we need one Channel per fold:------ @------ Fold worker <------Channel-----                    |        |--- Fold worker <------Channel------Driver---                    |        |--- Fold worker <------Channel-------- @------ Note: If the stream pusher terminates due to an exception, we do not--- actively terminate the fold. It gets cleaned up by the GC.------------------------------------------------------------------------------------ Process events received by a fold worker from a fold driver----------------------------------------------------------------------------------sendToDriver :: Channel m a b -> ChildEvent b -> IO Int-sendToDriver sv msg = do-    -- In case the producer stream is blocked on pushing to the fold buffer-    -- then wake it up so that it can check for the stop event or exception-    -- being sent to it otherwise we will be deadlocked.-    -- void $ tryPutMVar (pushBufferMVar sv) ()-    sendWithDoorBell (outputQueueFromConsumer sv)-                     (outputDoorBellFromConsumer sv) msg--sendYieldToDriver :: MonadIO m => Channel m a b -> b -> m ()-sendYieldToDriver sv res = liftIO $ do-    void $ sendToDriver sv (ChildYield res)--{-# NOINLINE sendExceptionToDriver #-}-sendExceptionToDriver :: Channel m a b -> SomeException -> IO ()-sendExceptionToDriver sv e = do-    tid <- myThreadId-    void $ sendToDriver sv (ChildStop tid (Just e))--data FromSVarState m a b =-      FromSVarRead (Channel m a b)-    | FromSVarLoop (Channel m a b) [ChildEvent a]--{-# INLINE_NORMAL fromProducerD #-}-fromProducerD :: MonadIO m => Channel m a b -> D.Stream m a-fromProducerD svar = D.Stream step (FromSVarRead svar)--    where--    {-# INLINE_LATE step #-}-    step _ (FromSVarRead sv) = do-        list <- readOutputQ sv-        -- Reversing the output is important to guarantee that we process the-        -- outputs in the same order as they were generated by the constituent-        -- streams.-        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)--    step _ (FromSVarLoop sv []) = return $ D.Skip $ FromSVarRead sv-    step _ (FromSVarLoop sv (ev : es)) = do-        case ev of-            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)-            ChildStopChannel -> return D.Stop-            _ -> undefined--{-# INLINE readOutputQChan #-}-readOutputQChan :: Channel m a b -> IO ([ChildEvent a], Int)-readOutputQChan chan = do-    let ss = if svarInspectMode chan then Just (svarStats chan) else Nothing-    r@(_, n) <- readOutputQRaw (outputQueue chan) ss-    if n <= 0-    then do-        liftIO-            $ withDiagMVar-                (svarInspectMode chan)-                (dumpSVar chan)-                "readOutputQChan: nothing to do"-            $ takeMVar (outputDoorBell chan)-        readOutputQRaw (outputQueue chan) ss-    else return r--{-# INLINE readOutputQDB #-}-readOutputQDB :: Channel m a b -> IO ([ChildEvent a], Int)-readOutputQDB chan = do-    r <- readOutputQChan chan-    -- XXX We can do this only if needed, if someone sleeps because of buffer-    -- then they can set a flag and we ring the doorbell only if the flag is-    -- set. Like we do in sendWorkerWait for streams.-    _ <- tryPutMVar (bufferSpaceDoorBell chan) ()-    return r--mkNewChannel :: forall m a b. MonadIO m => Config -> IO (Channel m a b)-mkNewChannel cfg = do-    outQ <- newIORef ([], 0)-    outQMv <- newEmptyMVar-    outQRev <- newIORef ([], 0)-    outQMvRev <- newEmptyMVar-    bufferMv <- newEmptyMVar--    stats <- newSVarStats-    tid <- myThreadId--    let getSVar :: Channel m a b -> Channel m a b-        getSVar sv = Channel-            { outputQueue      = outQ-            , outputDoorBell   = outQMv-            , outputQueueFromConsumer = outQRev-            , outputDoorBellFromConsumer = outQMvRev-            , bufferSpaceDoorBell = bufferMv-            , maxBufferLimit   = getMaxBuffer cfg-            , readOutputQ      = liftIO $ fmap fst (readOutputQDB sv)-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode cfg-            , svarCreator      = tid-            , svarStats        = stats-            }--    let sv = getSVar sv in return sv--{-# INLINABLE newChannel #-}-{-# SPECIALIZE newChannel ::-    (Config -> Config) -> Fold IO a b -> IO (Channel IO a b) #-}-newChannel :: (MonadRunInIO m) =>-    (Config -> Config) -> Fold m a b -> m (Channel m a b)-newChannel modifier f = do-    let config = modifier defaultConfig-    sv <- liftIO $ mkNewChannel config-    mrun <- askRunInIO-    void $ doForkWith (getBound config) (work sv) mrun (sendExceptionToDriver sv)-    return sv--    where--    {-# NOINLINE work #-}-    work chan =-        let f1 = Fold.rmapM (void . sendYieldToDriver chan) f-         in D.fold f1 $ fromProducerD chan------------------------------------------------------------------------------------ Process events received by the driver thread from the fold worker side------------------------------------------------------------------------------------ XXX currently only one event is sent by a fold consumer to the stream--- producer. But we can potentially have multiple events e.g. the fold step can--- generate exception more than once and the producer can ignore those--- exceptions or handle them and still keep driving the fold.---- XXX In case of scan this could be a stream.---- | Poll for events sent by the fold worker to the fold driver. The fold--- consumer can send a "Stop" event or an exception. When a "Stop" is received--- this function returns 'True'. If an exception is recieved then it throws the--- exception.----{-# NOINLINE checkFoldStatus #-}-checkFoldStatus :: MonadAsync m => Channel m a b -> m (Maybe b)-checkFoldStatus sv = do-    (list, _) <- liftIO $ readOutputQBasic (outputQueueFromConsumer sv)-    -- Reversing the output is important to guarantee that we process the-    -- outputs in the same order as they were generated by the constituent-    -- streams.-    processEvents $ reverse list--    where--    {-# INLINE processEvents #-}-    processEvents [] = return Nothing-    processEvents (ev : _) = do-        case ev of-            ChildStop _ e -> maybe undefined throwM e-            ChildStopChannel -> undefined-            ChildYield b -> return (Just b)--{-# INLINE isBufferAvailable #-}-isBufferAvailable :: MonadIO m => Channel m a b -> m Bool-isBufferAvailable sv = do-    let limit = maxBufferLimit sv-    case limit of-        Unlimited -> return True-        Limited lim -> do-            (_, n) <- liftIO $ readIORef (outputQueue sv)-            return $ fromIntegral lim > n---- | Push values from a driver to a fold worker via a Channel. Before pushing a--- value to the Channel it polls for events received from the fold worker.  If a--- stop event is received then it returns 'True' otherwise false.  Propagates--- exceptions received from the fold wroker.----{-# INLINE sendToWorker #-}-sendToWorker :: MonadAsync m => Channel m a b -> a -> m (Maybe b)-sendToWorker chan a = go--    where--    -- Recursive function, should we use SPEC?-    go = do-        let qref = outputQueueFromConsumer chan-        status <- do-            (_, n) <- liftIO $ readIORef qref-            if n > 0-            then checkFoldStatus chan-            else return Nothing-        case status of-            Just _ -> return status-            Nothing -> do-                    r <- isBufferAvailable chan-                    if r-                    then do-                        liftIO-                            $ void-                            $ sendWithDoorBell-                                (outputQueue chan)-                                (outputDoorBell chan)-                                (ChildYield a)-                        return Nothing-                    else do-                        () <- liftIO $ takeMVar (bufferSpaceDoorBell chan)-                        go
src/Streamly/Internal/Data/Fold/Prelude.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Fold.Prelude -- Copyright   : (c) 2022 Composewell Technologies@@ -8,12 +10,18 @@ -- module Streamly.Internal.Data.Fold.Prelude     (-      module Streamly.Internal.Data.Fold.Async+    -- * Channel+      module Streamly.Internal.Data.Fold.Channel+    -- * Concurrency     , module Streamly.Internal.Data.Fold.Concurrent+    -- * Time+    , module Streamly.Internal.Data.Fold.Time+    -- * Deprecated     , module Streamly.Internal.Data.Fold.SVar     ) where -import Streamly.Internal.Data.Fold.Async+import Streamly.Internal.Data.Fold.Channel import Streamly.Internal.Data.Fold.Concurrent import Streamly.Internal.Data.Fold.SVar+import Streamly.Internal.Data.Fold.Time
src/Streamly/Internal/Data/Fold/SVar.hs view
@@ -9,6 +9,7 @@ -- -- module Streamly.Internal.Data.Fold.SVar+    {-# DEPRECATED "The functionality is moved to Fold.Concurrent" #-}     (       write     , writeLimited
+ src/Streamly/Internal/Data/Fold/Time.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Time+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Fold.Time+    (+      takeInterval+    , intervalsOf+    )+where++import Control.Concurrent (threadDelay, forkIO, killThread)+import Control.Concurrent.MVar (MVar, newMVar, swapMVar, readMVar)+import Control.Exception (SomeException(..), catch, mask)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Streamly.Data.Fold (many)+import Streamly.Internal.Data.Fold (Fold(..), Step (..))+import Streamly.Internal.Control.Concurrent (MonadAsync, withRunInIO)+import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))++#include "DocTestDataFold.hs"++-- XXX We can use asyncClock here. A parser can be used to return an input that+-- arrives after the timeout.+-- XXX If n is 0 return immediately in initial.+-- XXX we should probably discard the input received after the timeout like+-- takeEndBy_.++-- XXX The foldMany doctest is important for consistency with the "many" fold,+-- and intervalsOf. We should put it in tests.++-- | @takeInterval n fold@ uses @fold@ to fold the input items arriving within+-- a window of first @n@ seconds.+--+-- >>> input = Stream.delay 0.2 $ Stream.fromList [1..10]+-- >>> Stream.fold (Fold.takeInterval 1.0 Fold.toList) input+-- [1,2,3,4,5,6]+--+-- >>> f = Fold.takeInterval 0.5 Fold.toList+-- >>> Stream.fold Fold.toList $ Stream.foldMany f input+-- [[1,2,3,4],[5,6,7],[8,9,10]]+--+-- Stops when @fold@ stops or when the timeout occurs. Note that the fold needs+-- an input after the timeout to stop. For example, if no input is pushed to+-- the fold until one hour after the timeout had occurred, then the fold will+-- be done only after consuming that input.+--+-- /Pre-release/+--+{-# INLINE takeInterval #-}+takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b+takeInterval n (Fold step initial done final) =+    Fold step' initial' done' final'++    where++    initial' = do+        res <- initial+        case res of+            Partial s -> do+                mv <- liftIO $ newMVar False+                t <-+                    withRunInIO $ \run ->+                        mask $ \restore -> do+                            tid <-+                                forkIO+                                  $ catch+                                        (restore $ void $ run (timerThread mv))+                                        (handleChildException mv)+                            run (return tid)+                return $ Partial $ Tuple3' s mv t+            Done b -> return $ Done b++    step' (Tuple3' s mv t) a = do+        val <- liftIO $ readMVar mv+        if val+        then do+            res <- step s a+            case res of+                Partial sres -> Done <$> final sres+                Done bres -> return $ Done bres+        else do+            res <- step s a+            case res of+                Partial fs -> return $ Partial $ Tuple3' fs mv t+                Done b -> liftIO (killThread t) >> return (Done b)++    done' (Tuple3' s _ _) = done s++    final' (Tuple3' s _ _) = final s++    timerThread mv = do+        liftIO $ threadDelay (round $ n * 1000000)+        -- Use IORef + CAS? instead of MVar since its a Bool?+        liftIO $ void $ swapMVar mv True++    handleChildException :: MVar Bool -> SomeException -> IO ()+    handleChildException mv _ = void $ swapMVar mv True++-- For example, we can copy and distribute a stream to multiple folds where+-- each fold can group the input differently e.g. by one second, one minute and+-- one hour windows respectively and fold each resulting stream of folds.++-- XXX This needs to be fixed like intervalsOf in Data.Stream.Time.++-- | Group the input stream into windows of n second each using the first fold+-- and then fold the resulting groups using the second fold.+--+-- >>> intervals = Fold.intervalsOf 0.5 Fold.toList Fold.toList+-- >>> Stream.fold intervals $ Stream.delay 0.2 $ Stream.fromList [1..10]+-- [[1,2,3,4],[5,6,7],[8,9,10]]+--+-- > intervalsOf n split = many (takeInterval n split)+--+-- /Pre-release/+--+{-# INLINE intervalsOf #-}+intervalsOf :: MonadAsync m => Double -> Fold m a b -> Fold m b c -> Fold m a c+intervalsOf n split = many (takeInterval n split)
src/Streamly/Internal/Data/IsMap/HashMap.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}+ {-# OPTIONS_GHC -Wno-orphans #-}  -- |
src/Streamly/Internal/Data/SVar.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar -- Copyright   : (c) 2017 Composewell Technologies
src/Streamly/Internal/Data/SVar/Dispatch.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Dispatch -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Dispatch+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Latency collection       collectLatency
src/Streamly/Internal/Data/SVar/Pull.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Pull -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Pull+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Read Output       readOutputQBasic
src/Streamly/Internal/Data/SVar/Worker.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.SVar.Worker -- Copyright   : (c) 2017 Composewell Technologies@@ -8,6 +10,7 @@ -- -- module Streamly.Internal.Data.SVar.Worker+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Adjusting Limits       decrementYieldLimit
+ src/Streamly/Internal/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,425 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Concurrent+-- Copyright   : (c) 2024 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Scanl.Concurrent+    (+      parTeeWith+    , parDistributeScanM+    , parDistributeScan+    , parDemuxScanM+    , parDemuxScan+    )+where++#include "inline.hs"++import Control.Concurrent (newEmptyMVar, takeMVar, throwTo)+import Control.Monad.Catch (throwM)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (newIORef, readIORef, atomicModifyIORef)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Control.Concurrent (MonadAsync)+import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS)+import Streamly.Internal.Data.Fold (Step (..))+import Streamly.Internal.Data.Scanl (Scanl(..))+import Streamly.Internal.Data.Stream (Stream(..), Step(..))+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))++import qualified Data.Map.Strict as Map+import qualified Streamly.Internal.Data.Stream as Stream++import Streamly.Internal.Data.Fold.Channel.Type+import Streamly.Internal.Data.Channel.Types++#include "DocTestDataScanl.hs"++-------------------------------------------------------------------------------+-- Concurrent scans+-------------------------------------------------------------------------------++-- | Execute both the scans in a tee concurrently.+--+-- Example:+--+-- >>> src = Stream.delay 1 (Stream.enumerateFromTo 1 3)+-- >>> delay x = threadDelay 1000000 >> print x >> return x+-- >>> c1 = Scanl.lmapM delay Scanl.sum+-- >>> c2 = Scanl.lmapM delay Scanl.length+-- >>> dst = Scanl.parTeeWith id (,) c1 c2+-- >>> Stream.toList $ Stream.scanl dst src+-- ...+--+{-# INLINABLE parTeeWith #-}+parTeeWith :: MonadAsync m =>+       (Config -> Config)+    -> (a -> b -> c)+    -> Scanl m x a+    -> Scanl m x b+    -> Scanl m x c+parTeeWith cfg f c1 c2 = Scanl step initial extract final++    where++    getResponse ch1 ch2 = do+        -- NOTE: We do not need a queue and doorbell mechanism for this, a single+        -- MVar should be enough. Also, there is only one writer and it writes+        -- only once before we read it.+        let db1 = outputDoorBell ch1+        let q1 = outputQueue ch1+        (xs1, _) <- liftIO $ atomicModifyIORefCAS q1 $ \x -> (([],0), x)+        case xs1 of+            [] -> do+                liftIO $ takeMVar db1+                getResponse ch1 ch2+            x1 : [] -> do+                case x1 of+                    FoldException _tid ex -> do+                        -- XXX+                        -- liftIO $ throwTo ch2Tid ThreadAbort+                        cleanup ch1+                        cleanup ch2+                        liftIO $ throwM ex+                    FoldDone _tid b -> return (Left b)+                    FoldPartial b -> return (Right b)+                    FoldEOF _ -> error "parTeeWith: FoldEOF cannot occur here"+            _ -> error "parTeeWith: not expecting more than one msg in q"++    processResponses ch1 ch2 r1 r2 =+        return $ case r1 of+            Left b1 -> do+                case r2 of+                    Left b2 -> Done (f b1 b2)+                    Right b2 -> Done (f b1 b2)+            Right b1 -> do+                case r2 of+                    Left b2 -> Done (f b1 b2)+                    Right b2 -> Partial $ Tuple3' ch1 ch2 (f b1 b2)++    initial = do+        ch1 <- newScanChannel cfg c1+        ch2 <- newScanChannel cfg c2+        r1 <- getResponse ch1 ch2+        r2 <- getResponse ch2 ch1+        processResponses ch1 ch2 r1 r2++    step (Tuple3' ch1 ch2 _) x = do+        sendToWorker_ ch1 x+        sendToWorker_ ch2 x+        r1 <- getResponse ch1 ch2+        r2 <- getResponse ch2 ch1+        processResponses ch1 ch2 r1 r2++    extract (Tuple3' _ _ x) = return x++    final (Tuple3' ch1 ch2 x) = do+        finalize ch1+        finalize ch2+        -- XXX generate the final value?+        return x++-- There are two ways to implement a concurrent scan.+--+-- 1. Make the scan itself asynchronous, add the input to the queue, and then+-- extract the output. Extraction will have to be asynchronous, which will+-- require changes to the scan driver. This will require a different Scanl+-- type.+--+-- 2. A monolithic implementation of concurrent Stream->Stream scan, using a+-- custom implementation of the scan and the driver.++{-# ANN type ScanState Fuse #-}+data ScanState s q db f =+      ScanInit+    | ScanGo s q db [f]+    | ScanDrain q db [f]+    | ScanStop++-- XXX return [b] or just b?+-- XXX We can use a one way mailbox type abstraction instead of using an IORef+-- for adding new folds dynamically.++-- | Evaluate a stream by distributing its inputs across zero or more+-- concurrently running scans. New scans can be generated dynamically. Use+-- 'parDistributeScan' for an eaiser to use interface, if you do not need the+-- power of 'parDistributeScanM'.+--+-- Before processing each input element, the supplied action is executed to+-- produce additional scans. These scans are appended to the set of currently+-- active scans. If you do not want the same scan to be added repeatedly,+-- ensure that the action only generates it once (see the example below).+--+-- If there are no scans currently active, the input element is discarded.+-- The results from all active scans are collected and lattened into the+-- the output stream.+--+-- Concurrency and buffering:+--+-- If the input buffer (see 'maxBuffer') is bounded, a scan may block until+-- space becomes available. If any scan is blocked on buffer, all scans are+-- blocked. Processing continues only when all scans have buffer space+-- available.+--+-- Example:+--+-- >>> import Data.IORef+-- >>> ref <- newIORef [Scanl.take 5 Scanl.sum, Scanl.take 5 Scanl.length :: Scanl.Scanl IO Int Int]+-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))+-- >>> Stream.toList $ Scanl.parDistributeScanM id gen (Stream.enumerateFromTo 1 10)+-- ...+--+{-# INLINE parDistributeScanM #-}+parDistributeScanM :: MonadAsync m =>+    (Config -> Config) -> m [Scanl m a b] -> Stream m a -> Stream m [b]+parDistributeScanM cfg getFolds (Stream sstep state) =+    Stream step ScanInit++    where++    -- XXX can be written as a fold+    processOutputs chans events done = do+        case events of+            [] -> return (chans, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone tid b ->+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs (b:done)+                    FoldEOF tid -> do+                        let ch = filter (\(_, t) -> t /= tid) chans+                         in processOutputs ch xs done+                    FoldPartial b ->+                         processOutputs chans xs (b:done)++    collectOutputs qref chans = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs chans r []+        else return (chans, [])++    step _ ScanInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (ScanGo state q db [])++    step gst (ScanGo st q db chans) = do+        -- merge any new channels added since last input+        fxs <- getFolds+        newChans <- Prelude.mapM (newChannelWithScan q db cfg) fxs+        let allChans = chans ++ newChans++        -- Collect outputs from running channels+        (running, outputs) <- collectOutputs q allChans++        -- Send input to running folds+        res <- sstep (adaptState gst) st+        next <- case res of+            Yield x s -> do+                -- XXX The blocking will delay the processing of outputs.+                -- Should we yield the outputs before blocking?+                Prelude.mapM_ (`sendToWorker_` x) (fmap fst running)+                return $ ScanGo s q db running+            Skip s -> do+                return $ ScanGo s q db running+            Stop -> do+                Prelude.mapM_ finalize (fmap fst running)+                return $ ScanDrain q db running+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (ScanDrain q db chans) = do+        (running, outputs) <- collectOutputs q chans+        case running of+            [] -> return $ Yield outputs ScanStop+            _ -> do+                if null outputs+                then do+                    liftIO $ takeMVar db+                    return $ Skip (ScanDrain q db running)+                else return $ Yield outputs (ScanDrain q db running)+    step _ ScanStop = return Stop++-- | A pure variant of 'parDistributeScanM' that uses a fixed list of scans.+--+-- The provided scans are started once and run concurrently for the duration+-- of the stream. Each input element is distributed to all active scans, and+-- their outputs are collected and emitted together.+--+-- Example:+--+-- >>> xs = [Scanl.take 5 Scanl.sum, Scanl.take 5 Scanl.length :: Scanl.Scanl IO Int Int]+-- >>> Stream.toList $ Scanl.parDistributeScan id xs (Stream.enumerateFromTo 1 10)+-- ...+{-# INLINE parDistributeScan #-}+parDistributeScan :: MonadAsync m =>+    (Config -> Config) -> [Scanl m a b] -> Stream m a -> Stream m [b]+parDistributeScan cfg getFolds stream =+    Stream.concatEffect $ do+        ref <- liftIO $ newIORef getFolds+        let action = liftIO $ atomicModifyIORef ref (\xs -> ([], xs))+        return $ parDistributeScanM cfg action stream++{-# ANN type DemuxState Fuse #-}+data DemuxState s q db f =+      DemuxInit+    | DemuxGo s q db f+    | DemuxDrain q db f+    | DemuxStop++-- XXX We need to either (1) remember a key when done so that we do not add the+-- fold again because some inputs would be lost in between, or (2) have a+-- FoldYield constructor to yield repeatedly so that we can restart the+-- existing fold itself when it is done. But in that case we cannot change the+-- fold once it is started. Also the Map would keep on increasing in size as we+-- never delete a key. Whatever we do we should keep the non-concurrent fold as+-- well consistent with that.++-- | Evaluate a stream by routing each input to a scan determined by a key.+--+-- For each distinct key, the first input encountered triggers the creation+-- of a new scan (via the supplied key-to-scan function). This scan is then+-- added to the set of currently active scans. Subsequent inputs with the+-- same key are directed to the same scan.+--+-- If no scan can be created for a key, the input element is discarded.+--+-- When a constituent scan completes, its final output is emitted as part of+-- the composed output stream. The output of 'parDemuxScanM' is a stream of+-- key–value pairs, where each value is the output produced by the scan+-- corresponding to that key.+--+-- For a simpler interface, use 'parDemuxScan' if you do not need the full+-- flexibility of 'parDemuxScanM'.+--+-- Example:+--+-- >>> import qualified Data.Map.Strict as Map+-- >>> import Data.Maybe (fromJust)+-- >>> f1 = ("even", Scanl.take 5 Scanl.sum)+-- >>> f2 = ("odd",  Scanl.take 5 Scanl.sum)+-- >>> kv = Map.fromList [f1, f2]+-- >>> getScan k = return (fromJust $ Map.lookup k kv)+-- >>> getKey x = if even x then "even" else "odd"+-- >>> input = Stream.enumerateFromTo 1 10+-- >>> Stream.toList $ Scanl.parDemuxScanM id getKey getScan input+-- ...+--+{-# INLINE parDemuxScanM #-}+parDemuxScanM :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> m (Scanl m a b))+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScanM cfg getKey getFold (Stream sstep state) =+    Stream step DemuxInit++    where++    -- XXX can be written as a fold+    processOutputs keyToChan events done = do+        case events of+            [] -> return (keyToChan, done)+            (x:xs) ->+                case x of+                    FoldException _tid ex -> do+                        -- XXX report the fold that threw the exception+                        let chans = fmap snd $ Map.toList keyToChan+                        liftIO $ mapM_ (`throwTo` ThreadAbort) (fmap snd chans)+                        mapM_ cleanup (fmap fst chans)+                        liftIO $ throwM ex+                    FoldDone _tid o@(k, _) ->+                        let ch = Map.delete k keyToChan+                         in processOutputs ch xs (o:done)+                    FoldEOF tid ->+                        let chans = Map.toList keyToChan+                            ch = filter (\(_, (_, t)) -> t /= tid) chans+                         in processOutputs (Map.fromList ch) xs done+                    FoldPartial b ->+                         processOutputs keyToChan xs (b:done)++    collectOutputs qref keyToChan = do+        (_, n) <- liftIO $ readIORef qref+        if n > 0+        then do+            r <- fmap fst $ liftIO $ readOutputQBasic qref+            processOutputs keyToChan r []+        else return (keyToChan, [])++    step _ DemuxInit = do+        q <- liftIO $ newIORef ([], 0)+        db <- liftIO newEmptyMVar+        return $ Skip (DemuxGo state q db Map.empty)++    step gst (DemuxGo st q db keyToChan) = do+        -- Collect outputs from running channels+        (keyToChan1, outputs) <- collectOutputs q keyToChan++        -- Send input to the selected fold+        res <- sstep (adaptState gst) st++        next <- case res of+            Yield x s -> do+                -- XXX If the fold for a particular key is done and we see that+                -- key again. If we have not yet collected the done event we+                -- cannot restart the fold because the previous key is already+                -- installed. Thererfore, restarting the fold for the same key+                -- fraught with races.+                let k = getKey x+                (keyToChan2, ch) <-+                    case Map.lookup k keyToChan1 of+                        Nothing -> do+                            fld <- getFold k+                            r@(chan, _) <- newChannelWithScan q db cfg (fmap (k,) fld)+                            return (Map.insert k r keyToChan1, chan)+                        Just (chan, _) -> return (keyToChan1, chan)+                sendToWorker_ ch x+                return $ DemuxGo s q db keyToChan2+            Skip s ->+                return $ DemuxGo s q db keyToChan1+            Stop -> do+                let chans = fmap (fst . snd) $ Map.toList keyToChan1+                Prelude.mapM_ finalize chans+                return $ DemuxDrain q db keyToChan1+        if null outputs+        then return $ Skip next+        else return $ Yield outputs next+    step _ (DemuxDrain q db keyToChan) = do+        (keyToChan1, outputs) <- collectOutputs q keyToChan+        if Map.null keyToChan1+        -- XXX null outputs case+        then return $ Yield outputs DemuxStop+        else do+            if null outputs+            then do+                liftIO $ takeMVar db+                return $ Skip (DemuxDrain q db keyToChan1)+            else return $ Yield outputs (DemuxDrain q db keyToChan1)+    step _ DemuxStop = return Stop++-- | A pure variant of 'parDemuxScanM' where the key-to-scan mapping is+-- static and does not require monadic effects.+--+-- Each distinct key is deterministically mapped to a scan using the provided+-- function. The behavior is otherwise the same as 'parDemuxScanM'.+{-# INLINE parDemuxScan #-}+parDemuxScan :: (MonadAsync m, Ord k) =>+       (Config -> Config)+    -> (a -> k)+    -> (k -> Scanl m a b)+    -> Stream m a+    -> Stream m [(k, b)]+parDemuxScan cfg getKey getFold = parDemuxScanM cfg getKey (pure . getFold)
+ src/Streamly/Internal/Data/Scanl/Prelude.hs view
@@ -0,0 +1,19 @@+-- |+-- Module      : Streamly.Internal.Data.Scanl.Prelude+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Scanl.Prelude+    (+    -- * Channel+      module Streamly.Internal.Data.Fold.Channel+    -- * Concurrency+    , module Streamly.Internal.Data.Scanl.Concurrent+    )+where++import Streamly.Internal.Data.Fold.Channel+import Streamly.Internal.Data.Scanl.Concurrent
src/Streamly/Internal/Data/SmallArray/Type.hs view
@@ -1,4 +1,6 @@ {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoMonoLocalBinds #-}  -- | -- Module : Data.Primitive.SmallArray
+ src/Streamly/Internal/Data/Stream/Channel.hs view
@@ -0,0 +1,213 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel+    (+      module Streamly.Internal.Data.Stream.Channel.Type++    -- ** Allocation+    , module Streamly.Internal.Data.Stream.Channel.Append+    , module Streamly.Internal.Data.Stream.Channel.Interleave+    , newChannel++    -- ** Event Processing Loop+    , module Streamly.Internal.Data.Stream.Channel.Dispatcher+    , module Streamly.Internal.Data.Stream.Channel.Consumer+    , module Streamly.Internal.Data.Stream.Channel.Operations+    , chanConcatMapK++    -- ** Evaluation+    , withChannelK+    , withChannel+    -- quiesceChannel -- wait for running tasks but do not schedule any more.+    )+where++import Streamly.Internal.Control.Concurrent (MonadAsync)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Control.Concurrent (askRunInIO)+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Type+import Streamly.Internal.Data.Stream.Channel.Operations+import Streamly.Internal.Data.Stream.Channel.Append+import Streamly.Internal.Data.Stream.Channel.Interleave+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Consumer++-------------------------------------------------------------------------------+--  Channel allocation+-------------------------------------------------------------------------------++-- | Create a new concurrent stream evaluation channel. The monad+-- state used to run the stream actions is captured from the call site of+-- newChannel.+{-# INLINE newChannel #-}+newChannel :: MonadAsync m =>+    (Config -> Config) -> m (Channel m a)+newChannel modifier =+    let cfg = modifier defaultConfig+     in if getInterleaved cfg+        then newInterleaveChannel modifier+        else newAppendChannel modifier++-- | Allocate a channel and evaluate the stream concurrently using the channel+-- and the supplied evaluator function. The evaluator is run in a worker+-- thread.+{-# INLINE withChannelK #-}+withChannelK :: MonadAsync m =>+       (Config -> Config) -- ^ config modifier+    -> K.StreamK m a -- ^ input stream+    -> (Channel m b -> K.StreamK m a -> K.StreamK m b) -- ^ stream evaluator+    -> K.StreamK m b -- ^ output stream+withChannelK modifier input evaluator = K.concatEffect action++    where++    action = do+        chan <- newChannel modifier+        toChannelK chan (evaluator chan input)+        let cfg = modifier defaultConfig+        return $ fromChannelK (getCleanup cfg) chan++-- | A wrapper over 'withChannelK', converts 'Stream' to 'StreamK' and invokes+-- 'withChannelK'.+{-# INLINE withChannel #-}+withChannel :: MonadAsync m =>+       (Config -> Config)+    -> Stream m a+    -> (Channel m b -> Stream m a -> Stream m b)+    -> Stream m b+withChannel modifier input evaluator =+    let f chan stream = K.fromStream $ evaluator chan (K.toStream stream)+     in K.toStream $ withChannelK modifier (K.fromStream input) f++-------------------------------------------------------------------------------+-- Evaluator+-------------------------------------------------------------------------------++-- | @concatMapHeadK consumeTail mapHead stream@, maps a stream generation+-- function on the head element and performs a side effect on the tail.+--+-- Used for concurrent evaluation of streams using a Channel. A worker+-- evaluating the stream would queue the tail and go on to evaluate the head.+-- The tail is picked up by another worker which does the same.+{-# INLINE concatMapHeadK #-}+concatMapHeadK :: Monad m =>+       (K.StreamK m a -> m ()) -- ^ Queue the tail+    -> (a -> K.StreamK m b) -- ^ Generate a stream from the head+    -> K.StreamK m a+    -> K.StreamK m b+concatMapHeadK consumeTail mapHead stream =+    K.mkStream $ \st yld sng stp -> do+        let foldShared = K.foldStreamShared st yld sng stp+            single a = foldShared $ mapHead a+            yieldk a r = consumeTail r >> single a+         in K.foldStreamShared (adaptState st) yieldk single stp stream++-------------------------------------------------------------------------------+-- concat streams+-------------------------------------------------------------------------------++-- | 'mkEnqueue chan f returns a queuing function @enq@. @enq@ takes a+-- @stream@ and enqueues @f enq stream@ on the channel. One example of @f@ is+-- 'concatMapHeadK'. When the enqueued value with 'concatMapHeadK' as @f@ is+-- evaluated, it generates an output stream from the head and enqueues @f enq+-- tail@ on the channel. Thus whenever the enqueued stream is evaluated it+-- generates a stream from the head and queues the tail on the channel.+--+-- Note that @enq@ and runner are mutually recursive, mkEnqueue ties the+-- knot between the two.+--+{-# INLINE mkEnqueue #-}+mkEnqueue :: MonadAsync m =>+    Channel m b+    -- | @divider enq stream@+    -> ((K.StreamK m a -> m ()) -> K.StreamK m a -> K.StreamK m b)+    -- | Queuing function @enq@+    -> m (K.StreamK m a -> m ())+mkEnqueue chan runner = do+    runInIO <- askRunInIO+    return+        $ let f stream = do+                liftIO $ enqueue chan (runInIO, runner f stream)+                -- XXX In case of eager dispatch we can just directly dispatch+                -- a worker with the tail stream here rather than first queuing+                -- and then dispatching a worker which dequeues the work. The+                -- older implementation did a direct dispatch here and its perf+                -- characterstics looked much better.+                eagerDispatch chan+           in f++{-# INLINE parConcatMapChanKAll #-}+parConcatMapChanKAll :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKAll chan f stream =+   let run q = concatMapHeadK q f+    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)+    -- K.parConcatMap (_appendWithChanK chan) f stream++{-# INLINE parConcatMapChanKAny #-}+parConcatMapChanKAny :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKAny chan f stream =+   let done = K.nilM (shutdown chan)+       run q = concatMapHeadK q (\x -> K.append (f x) done)+    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)++{-# INLINE parConcatMapChanKFirst #-}+parConcatMapChanKFirst :: MonadAsync m =>+    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b+parConcatMapChanKFirst chan f stream =+   let done = K.nilM (shutdown chan)+       run q = concatMapHeadK q f+    in K.concatEffect $ do+        res <- K.uncons stream+        case res of+            Nothing -> return K.nil+            Just (h, t) -> do+                q <- mkEnqueue chan run+                q t+                return $ K.append (f h) done++-- | Make a concurrent stream evaluator from a stream, to be used in+-- 'withChannelK' or 'toChannelK'. Maps a stream generation function on each+-- element of the stream, the evaluation of the map on each element happens+-- concurrently. All the generated streams are merged together in the output of+-- the channel. The scheduling and termination behavior depends on the channel+-- settings.+--+-- Note that if you queue a stream on the channel using 'toChannelK', it will+-- be picked up by a worker and the worker would evaluate the entire stream+-- serially and emit the results on the channel. However, if you transform the+-- stream using 'parConcatMapChanK' and queue it on the channel, it+-- parallelizes the function map on each element of the stream. The simplest+-- example is @parConcatMapChanK id id@ which is equivalent to evaluating each+-- element of the stream concurrently.+--+-- A channel worker evaluating this function would enqueue the tail on the+-- channel's work queue and go on to evaluate the head generating an output+-- stream. The tail is picked up by another worker which does the same and so+-- on.+{-# INLINE chanConcatMapK #-}+chanConcatMapK :: MonadAsync m =>+       (Config -> Config)+    -> Channel m b+    -> (a -> K.StreamK m b)+    -> K.StreamK m a+    -> K.StreamK m b+chanConcatMapK modifier chan f stream = do+        let cfg = modifier defaultConfig+        case getStopWhen cfg of+            AllStop -> parConcatMapChanKAll chan f stream+            FirstStops -> parConcatMapChanKFirst chan f stream+            AnyStops -> parConcatMapChanKAny chan f stream
+ src/Streamly/Internal/Data/Stream/Channel/Append.hs view
@@ -0,0 +1,1102 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Append+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- The functions in this module are separated from the combinators using+-- these because of a GHC issue. We need to have newAppendChannel specialized but+-- not inlined. If we keep it in the same module as its users we cannot achieve+-- that and the code becomes bloated. But if it is in a separate module we can+-- use INLINABLE and SPECIALIZE on it which makes it specialized but it is not+-- actually inlined.++module Streamly.Internal.Data.Stream.Channel.Append+    (+      newAppendChannel+    )+where++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar (newEmptyMVar, newMVar, putMVar, takeMVar)+import Control.Exception (assert)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Heap (Heap, Entry(..))+import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef, writeIORef)+import GHC.Exts (inline)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, RunInIO(..), askRunInIO, restoreM)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS, atomicModifyIORefCAS_)+import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)++import qualified Data.Heap as H+import qualified Data.Set as Set+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker+import Streamly.Internal.Data.Stream.Channel.Consumer+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type++------------------------------------------------------------------------------+-- Concurrent streams with first-come-first serve results+------------------------------------------------------------------------------++{-# INLINE enqueueLIFO #-}+enqueueLIFO ::+      Channel m a+   -> IORef [(RunInIO m, K.StreamK m a)]+   -> (RunInIO m, K.StreamK m a)+   -> IO ()+enqueueLIFO sv q m = do+    atomicModifyIORefCAS_ q (m :)+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++{-# INLINE dequeue #-}+dequeue :: MonadIO m =>+       IORef [(RunInIO m, K.StreamK m a)]+    -> m (Maybe (RunInIO m, K.StreamK m a))+dequeue qref =+    liftIO+        $ atomicModifyIORefCAS qref+        $ \case+            (x : xs) -> (xs, Just x)+            x -> (x, Nothing)++data WorkerStatus = Continue | Suspend++{-# INLINE workLoopLIFO #-}+workLoopLIFO+    :: MonadRunInIO m+    => IORef [(RunInIO m, K.StreamK m a)]+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFO qref sv winfo = run++    where++    run = do+        work <- dequeue qref+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> process runin m++    process runin m = do+        -- XXX when we finish we need to send the monadic state back to+        -- the parent so that the state can be merged back. We capture+        -- and return the state in the stop continuation.+        --+        -- Instead of using the run function we can just restore the+        -- monad state here. That way it can work easily for+        -- distributed case as well.+        r <- liftIO $ runin $+                K.foldStreamShared+                    undefined+                    yieldk+                    single+                    (return Continue)+                    m+        res <- restoreM r+        case res of+            Continue -> run+            Suspend -> return ()++        where++        single a = do+            res <- liftIO $ yieldWith winfo sv a+            return $ if res then Continue else Suspend++        yieldk a r = do+            res <- liftIO $ yieldWith winfo sv a+            if res+            then K.foldStreamShared undefined yieldk single (return Continue) r+            else do+                runInIO <- askRunInIO+                liftIO $ enqueueLIFO sv qref (runInIO, r)+                return Suspend++-- We duplicate workLoop for yield limit and no limit cases because it has+-- around 40% performance overhead in the worst case.+--+-- XXX we can pass yinfo directly as an argument here so that we do not have to+-- make a check every time.+{-# INLINE workLoopLIFOLimited #-}+workLoopLIFOLimited+    :: forall m a. MonadRunInIO m+    => IORef [(RunInIO m, K.StreamK m a)]+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopLIFOLimited qref sv winfo = run++    where++    incrContinue =+        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue++    run = do+        work <- dequeue qref+        {- HLINT ignore "Use forM_" -}+        case work of+            Nothing -> return ()+            Just item -> process item++    process item@(RunInIO runin, m) = do+        -- XXX This is just a best effort minimization of concurrency+        -- to the yield limit. If the stream is made of concurrent+        -- streams we do not reserve the yield limit in the constituent+        -- streams before executing the action. This can be done+        -- though, by sharing the yield limit ref with downstream+        -- actions via state passing. Just a todo.+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if yieldLimitOk+        then do+            r <- liftIO $ runin $+                    K.foldStreamShared+                        undefined+                        yieldk+                        single+                        incrContinue+                        m+            res <- restoreM r+            case res of+                Continue -> run+                Suspend -> return ()+        -- Avoid any side effects, undo the yield limit decrement if we+        -- never yielded anything.+        else liftIO $ do+            enqueueLIFO sv qref item+            incrementYieldLimit (remainingWork sv)++        where++        single a = do+            res <- liftIO $ yieldWith winfo sv a+            return $ if res then Continue else Suspend++        -- XXX can we pass on the yield limit downstream to limit the+        -- concurrency of constituent streams.+        yieldk a r = do+            res <- liftIO $ yieldWith winfo sv a+            yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+            if res && yieldLimitOk+            then K.foldStreamShared undefined yieldk single incrContinue r+            else do+                runInIO <- askRunInIO+                liftIO $ incrementYieldLimit (remainingWork sv)+                liftIO $ enqueueLIFO sv qref (runInIO, r)+                return Suspend++-------------------------------------------------------------------------------+-- Ahead Channel Data Structures+-------------------------------------------------------------------------------++-- XXX Left associated ahead expressions are expensive. We start a new SVar for+-- each left associative expression. The queue is used only for right+-- associated expression, we queue the right expression and execute the left.+-- Therefore the queue never has more than one item in it. However, in case of+-- parIterateConcatMap the iteration may add more items at the end of the+-- queue.+--+-- XXX we can fix this. When we queue more than one item on the queue we can+-- mark the previously queued item as not-runnable. The not-runnable item is+-- not dequeued until the already running one has finished and at that time we+-- would also know the exact sequence number of the already queued item.+--+-- we can even run the already queued items but they will have to be sorted in+-- layers in the heap. We can use a list of heaps for that.+{-# ANN enqueueAhead "HLint: ignore" #-}+{-# INLINE enqueueAhead #-}+enqueueAhead ::+       Channel m a+    -> IORef ([K.StreamK m a], Int)+    -> (RunInIO m, K.StreamK m a)+    -> IO ()+enqueueAhead sv q m = do+    -- XXX The queue is LIFO. When parConcatIterate queues more than one items+    -- to the queue it will perform a DFS style traversal. For BFS we will have+    -- to use a FIFO data structure here. That would require another Config+    -- option.+    atomicModifyIORefCAS_ q $ \(xs, n) -> (snd m:xs, n)+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++-- Normally the thread that has the token should never go away. The token gets+-- handed over to another thread, but someone or the other has the token at any+-- point of time. But if the task that has the token finds that the outputQueue+-- is full, in that case it can go away without even handing over the token to+-- another thread. In that case it sets the nextSequence number in the heap its+-- own sequence number before going away. To handle this case, any task that+-- does not have the token tries to dequeue from the heap first before+-- dequeuing from the work queue. If it finds that the task at the top of the+-- heap is the one that owns the current sequence number then it grabs the+-- token and starts with that.+--+-- XXX instead of queueing just the head element and the remaining computation+-- on the heap, evaluate as many as we can and place them on the heap. But we+-- need to give higher priority to the lower sequence numbers so that lower+-- priority tasks do not fill up the heap making higher priority tasks block+-- due to full heap. Maybe we can have a weighted space for them in the heap.+-- The weight is inversely proportional to the sequence number.+--+-- XXX review for livelock++{-# INLINE dequeueAhead #-}+dequeueAhead :: MonadIO m+    => IORef ([K.StreamK m a], Int) -> m (Maybe (K.StreamK m a, Int))+dequeueAhead q = liftIO $+    atomicModifyIORefCAS q $ \case+            ([], n) -> (([], n), Nothing)+            (x : xs, n) -> ((xs, n + 1), Just (x, n + 1))++-- Dequeue only if the seq number matches the expected seq number.+{-# INLINE dequeueAheadSeqCheck #-}+dequeueAheadSeqCheck :: MonadIO m+    => IORef ([K.StreamK m a], Int) -> Int -> m (Maybe (K.StreamK m a))+dequeueAheadSeqCheck q seqNo = liftIO $+    atomicModifyIORefCAS q $ \case+            ([], n) -> (([], n), Nothing)+            (x : xs, n) ->+                if n + 1 == seqNo+                then ((xs, n + 1), Just x)+                else ((x : xs, n), Nothing)++-------------------------------------------------------------------------------+-- Heap manipulation+-------------------------------------------------------------------------------++withIORef :: IORef a -> (a -> IO b) -> IO b+withIORef ref f = readIORef ref >>= f++atomicModifyIORef_ :: IORef a -> (a -> a) -> IO ()+atomicModifyIORef_ ref f =+    atomicModifyIORef ref $ \x -> (f x, ())++data AheadHeapEntry m a =+      AheadEntryNull -- ^ an empty result, required for sequencing+    | AheadEntryPure a -- ^ a yielded value+    -- ^ A stream with its head possibly evaluated, and tail unevaluated+    | AheadEntryStream (RunInIO m, Maybe a, K.StreamK m a)++data HeapDequeueResult m a =+    -- | Not dequeued because someone is processing the heap. This is indicated+    -- by the second component of the heap IORef tuple being set to 'Nothing'.+      Clearing+    -- | Not dequeued because the seq no. of the top entry is not the next one+    -- expected in seqeunce, we have to wait.+    | Waiting Int+    -- | dequeued successfully, the seq no. of the top entry is the next one+    -- expected in sequence.+    | Ready (Entry Int (AheadHeapEntry m a))++-- | The heap is stored in an IORef along with a sequence number. When the+-- sequence number is set to 'Nothing' it means we are processing the heap. The+-- type of the dequeued entry would be 'Clearing' in this case. When the+-- sequence number in the IORef is set to 'Just' then it is the next expected+-- sequence number. If the dequeued entry matches with this expected sequence+-- number then it is 'Ready' and dequeued otherwise it is 'Waiting'. When we+-- return 'Clearing' or 'Waiting', the heap is not modified i.e. nothing is+-- dequeued.+--+-- Note, when we have n streams each consisting of multiple items composed with+-- "ordered" execution then the entire stream is treated as one item with the+-- given sequence number and all of its elements are yielded serially.+{-# INLINE dequeueFromHeap #-}+dequeueFromHeap+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -- ^ (heap, Maybe sequence-no).+    -> IO (HeapDequeueResult m a)+dequeueFromHeap hpVar =+    atomicModifyIORef hpVar $ \pair@(hp, snum) ->+        case snum of+            Nothing -> (pair, Clearing)+            Just n -> do+                let r = H.uncons hp+                case r of+                    Just (ent@(Entry seqNo _ev), hp') ->+                            if seqNo == n+                            then ((hp', Nothing), Ready ent)+                            else assert (seqNo >= n) (pair, Waiting n)+                    Nothing -> (pair, Waiting n)++-- | Called only when the heap is being processed to transfer entries to output+-- queue. Matches the sequence number of the dequeued entry with the supplied+-- sequence number to determine if the entry is 'Ready' or 'Waiting'. Heap is+-- not modified if we return 'Waiting' i.e. entry is not dequeued.+{-# INLINE dequeueFromHeapSeq #-}+dequeueFromHeapSeq+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Int+    -> IO (HeapDequeueResult m a)+dequeueFromHeapSeq hpVar i =+    atomicModifyIORef hpVar $ \(hp, snum) ->+        case snum of+            Nothing -> do+                let r = H.uncons hp+                case r of+                    Just (ent@(Entry seqNo _ev), hp') ->+                        if seqNo == i+                        then ((hp', Nothing), Ready ent)+                        else assert (seqNo >= i) ((hp, Just i), Waiting i)+                    Nothing -> ((hp, Just i), Waiting i)+            Just _ -> error "dequeueFromHeapSeq: unreachable"++heapIsSane :: Maybe Int -> Int -> Bool+heapIsSane snum seqNo =+    case snum of+        Nothing -> True+        Just n -> seqNo >= n++{-# INLINE requeueOnHeapTop #-}+requeueOnHeapTop+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Entry Int (AheadHeapEntry m a)+    -> Int+    -> IO ()+requeueOnHeapTop hpVar ent seqNo =+    atomicModifyIORef_ hpVar $ \(hp, snum) ->+        assert (heapIsSane snum seqNo) (H.insert ent hp, Just seqNo)++{-# INLINE updateHeapSeq #-}+updateHeapSeq+    :: IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Int+    -> IO ()+updateHeapSeq hpVar seqNo =+    atomicModifyIORef_ hpVar $ \(hp, snum) ->+        assert (heapIsSane snum seqNo) (hp, Just seqNo)++------------------------------------------------------------------------------+-- Ahead: Concurrent streams with ordered results+------------------------------------------------------------------------------++-- Lookahead streams can execute multiple tasks concurrently, ahead of time,+-- but always serve them in the same order as they appear in the stream. To+-- implement lookahead streams efficiently we assign a sequence number to each+-- task when the task is picked up for execution. When the task finishes, the+-- output is tagged with the same sequence number and we rearrange the outputs+-- in sequence based on that number.+--+-- To explain the mechanism imagine that the current task at the head of the+-- stream has a "token" to yield to the outputQueue. The ownership of the token+-- is determined by the current sequence number is maintained in outputHeap.+-- Sequence number is assigned when a task is queued. When a thread dequeues a+-- task it picks up the sequence number as well and when the output is ready it+-- uses the sequence number to queue the output to the outputQueue.+--+-- The thread with current sequence number sends the output directly to the+-- outputQueue. Other threads push the output to the outputHeap. When the task+-- being queued on the heap is a stream of many elements we evaluate only the+-- first element and keep the rest of the unevaluated computation in the heap.+-- When such a task gets the "token" for outputQueue it evaluates and directly+-- yields all the elements to the outputQueue without checking for the+-- "token".+--+-- Note that no two outputs in the heap can have the same sequence numbers and+-- therefore we do not need a stable heap. We have also separated the buffer+-- for the current task (outputQueue) and the pending tasks (outputHeap) so+-- that the pending tasks cannot interfere with the current task. Note that for+-- a single task just the outputQueue is enough and for the case of many+-- threads just a heap is good enough. However we balance between these two+-- cases, so that both are efficient.+--+-- For bigger streams it may make sense to have separate buffers for each+-- stream. However, for singleton streams this may become inefficient. However,+-- if we do not have separate buffers, then the streams that come later in+-- sequence may hog the buffer, hindering the streams that are ahead. For this+-- reason we have a single element buffer limitation for the streams being+-- executed in advance.+--+-- This scheme works pretty efficiently with less than 40% extra overhead+-- compared to the Async streams where we do not have any kind of sequencing of+-- the outputs. It is especially devised so that we are most efficient when we+-- have short tasks and need just a single thread. Also when a thread yields+-- many items it can hold lockfree access to the outputQueue and do it+-- efficiently.+--+-- XXX Maybe we can start the ahead threads at a lower cpu and IO priority so+-- that they do not hog the resources and hinder the progress of the threads in+-- front of them.++-- Left associated ahead expressions are expensive. We start a new SVar for+-- each left associative expression. The queue is used only for right+-- associated expression, we queue the right expression and execute the left.+-- Thererefore the queue never has more than on item in it.+--+-- XXX Also note that limiting concurrency for cases like "take 10" would not+-- work well with left associative expressions, because we have no visibility+-- about how much the left side of the expression would yield.+--+-- XXX It may be a good idea to increment sequence numbers for each yield,+-- currently a stream on the left side of the expression may yield many+-- elements with the same sequene number. We can then use the seq number to+-- enforce yieldMax and yieldLImit as well.++-- Invariants:+--+-- * A worker should always ensure that it pushes all the consecutive items in+-- the heap to the outputQueue especially the items on behalf of the workers+-- that have already left when we were holding the token. This avoids deadlock+-- conditions when the later workers completion depends on the consumption of+-- earlier results. For more details see comments in the consumer pull side+-- code.++{-# INLINE underMaxHeap #-}+underMaxHeap ::+       Channel m a+    -> Heap (Entry Int (AheadHeapEntry m a))+    -> IO Bool+underMaxHeap sv hp = do+    (_, len) <- readIORef (outputQueue sv)++    -- XXX simplify this+    let maxHeap = case maxBufferLimit sv of+            Limited lim -> Limited $+                max 0 (lim - fromIntegral len)+            Unlimited -> Unlimited++    case maxHeap of+        Limited lim -> do+            active <- readIORef (workerCount sv)+            return $ H.size hp + active <= fromIntegral lim+        Unlimited -> return True++-- Return value:+-- True => stop+-- False => continue+preStopCheck ::+       Channel m a+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)) , Maybe Int)+    -> IO Bool+preStopCheck sv heap =+    -- check the stop condition under a lock before actually+    -- stopping so that the whole herd does not stop at once.+    withIORef heap $ \(hp, _) -> do+        heapOk <- underMaxHeap sv hp+        takeMVar (workerStopMVar sv)+        let stopping = do+                putMVar (workerStopMVar sv) ()+                return True+            continue = do+                putMVar (workerStopMVar sv) ()+                return False+        if heapOk+        then+            case yieldRateInfo sv of+                Nothing -> continue+                Just yinfo -> do+                    beyondRate <-+                        isBeyondMaxRate+                            (maxWorkerLimit sv) (workerCount sv) yinfo+                    if beyondRate then stopping else continue+        else stopping++-- XXX In absence of a "noyield" primitive (i.e. do not pre-empt inside a+-- critical section) from GHC RTS, we have a difficult problem. Assume we have+-- a 100,000 threads producing output and queuing it to the heap for+-- sequencing. The heap can be drained only by one thread at a time, any thread+-- that finds that heap can be drained now, takes a lock and starts draining+-- it, however the thread may get prempted in the middle of it holding the+-- lock. Since that thread is holding the lock, the other threads cannot pick+-- up the draining task, therefore they proceed to picking up the next task to+-- execute. If the draining thread could yield voluntarily at a point where it+-- has released the lock, then the next threads could pick up the draining+-- instead of executing more tasks. When there are 100,000 threads the drainer+-- gets a cpu share to run only 1:100000 of the time. This makes the heap+-- accumulate a lot of output when we the buffer size is large.+--+-- The solutions to this problem are:+-- 1) make the other threads wait in a queue until the draining finishes+-- 2) make the other threads queue and go away if draining is in progress+--+-- In both cases we give the drainer a chance to run more often.++-- | Move entries from the heap to the channel's output queue. Only those+-- entries which are in correct order are transferred. Stop whenever a missing+-- sequence number is encountered.+--+-- We enter this function only when we have verified that the sequence number+-- passed to it is the next expected sequence number.+processHeap+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int) -- ^ work queue+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int) -- ^ heap+    -> Channel m a+    -> Maybe WorkerInfo+    -> AheadHeapEntry m a -- heap entry dequeued from top of heap+    -> Int -- seq no. of the heap entry, this is the next correct seq no.+    -> Bool -- True if we are draining the heap when we are finally stopping+    -> m ()+processHeap q heap sv winfo entry sno stopping = loopHeap sno entry++    where++    -- We do not stop the worker on buffer full here as we want to proceed to+    -- nextHeap anyway so that we can clear any subsequent entries. We stop+    -- only in yield continuation where we may have a remaining stream to be+    -- pushed on the heap.+    singleStreamFromHeap seqNo a = do+        void $ liftIO $ yieldWith winfo sv a+        nextHeap seqNo++    yieldStreamFromHeap seqNo a r = do+        continue <- liftIO $ yieldWith winfo sv a+        runStreamWithYieldLimit continue seqNo r++    -- XXX when we have an unfinished stream on the heap we cannot account all+    -- the yields of that stream until it finishes, so if we have picked up+    -- and executed more actions beyond that in the parent stream and put them+    -- on the heap then they would eat up some yield limit which is not+    -- correct, we will think that our yield limit is over even though we have+    -- to yield items from unfinished stream before them. For this reason, if+    -- there are pending items in the heap we drain them unconditionally+    -- without considering the yield limit.+    runStreamWithYieldLimit continue seqNo r = do+        _ <- liftIO $ decrementYieldLimit (remainingWork sv)+        if continue -- see comment above -- && yieldLimitOk+        then do+            let stopk = do+                  liftIO (incrementYieldLimit (remainingWork sv))+                  nextHeap seqNo+            K.foldStreamShared undefined+                          (yieldStreamFromHeap seqNo)+                          (singleStreamFromHeap seqNo)+                          stopk+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, Nothing, r))+            liftIO $ do+                requeueOnHeapTop heap ent seqNo+                incrementYieldLimit (remainingWork sv)++    processWorkQueue prevSeqNo = do+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if yieldLimitOk+        then do+            work <- dequeueAhead q+            case work of+                Nothing -> return ()+                Just (m, seqNo) -> do+                    if seqNo == prevSeqNo + 1+                    then processWithToken q heap sv winfo m seqNo+                    else processWithoutToken q heap sv winfo m seqNo+        else liftIO $ incrementYieldLimit (remainingWork sv)++    nextHeap prevSeqNo = do+        res <- liftIO $ dequeueFromHeapSeq heap (prevSeqNo + 1)+        case res of+            Ready (Entry seqNo hent) -> loopHeap seqNo hent+            Clearing -> return ()+            Waiting _ ->+                if stopping+                then do+                    r <- liftIO $ preStopCheck sv heap+                    if r+                    then return ()+                    else processWorkQueue prevSeqNo+                else inline processWorkQueue prevSeqNo++    -- The main loop processing the heap. The seqNo is correct in sequence,+    -- this is the one we should be sending to output next.+    loopHeap seqNo ent =+        case ent of+            AheadEntryNull -> nextHeap seqNo+            AheadEntryPure a -> do+                -- Use 'send' directly so that we do not account this in worker+                -- latency as this will not be the real latency.+                -- Don't stop the worker in this case as we are just+                -- transferring available results from heap to outputQueue.+                void+                    $ liftIO+                    $ sendEvent+                        (outputQueue sv) (outputDoorBell sv) (ChildYield a)+                nextHeap seqNo+            AheadEntryStream (RunInIO runin, Just a, r) -> do+                let+                    action = do+                        -- XXX deduplicate this code with the same code above+                        void+                            $ liftIO+                            $ sendEvent+                                (outputQueue sv) (outputDoorBell sv) (ChildYield a)+                        runStreamWithYieldLimit True seqNo r+                    go = do+                        res <- liftIO $ runin action+                        restoreM res+                if stopping+                then do+                    stopIt <- liftIO $ preStopCheck sv heap+                    if stopIt+                    then liftIO $ do+                        -- put the entry back in the heap and stop+                        requeueOnHeapTop heap (Entry seqNo ent) seqNo+                    else go+                else go+            AheadEntryStream (RunInIO runin, Nothing, r) -> do+                -- XXX deuplicate this code with the code above+                let+                    action = runStreamWithYieldLimit True seqNo r+                    go = do+                        res <- liftIO $ runin action+                        restoreM res+                if stopping+                then do+                    stopIt <- liftIO $ preStopCheck sv heap+                    if stopIt+                    then liftIO $ do+                        -- put the entry back in the heap and stop+                        requeueOnHeapTop heap (Entry seqNo ent) seqNo+                    else go+                else go++{-# NOINLINE drainHeap #-}+drainHeap+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+drainHeap q heap sv winfo = do+    r <- liftIO $ dequeueFromHeap heap+    case r of+        Ready (Entry seqNo hent) ->+            processHeap q heap sv winfo hent seqNo True+        _ -> return ()++data HeapStatus = HContinue | HStop++-- XXX Rename to processOutOfOrder++-- | Without token means the worker is working on an item which not the next in+-- sequence, therefore, the output has to be placed on the heap rather than+-- sending it directly to the output queue.+--+processWithoutToken+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> K.StreamK m a+    -> Int+    -> m ()+processWithoutToken q heap sv winfo m seqNo = do+    -- we have already decremented the yield limit for m+    let stopk = do+            liftIO (incrementYieldLimit (remainingWork sv))+            -- If the stream stops without yielding anything, and we do not put+            -- anything on heap, but if heap was waiting for this seq number+            -- then it will keep waiting forever, because we are never going to+            -- put it on heap. So we have to put a null entry on heap even when+            -- we stop.+            toHeap AheadEntryNull+        mrun = runInIO $ svarMrun sv++    -- XXX When StreamD streams are converted to StreamK, even for singleton+    -- streams we have a yield and a stop. That can cause perf overhead in case+    -- of concurrent workers. We should always create streams with a "single"+    -- continuation.+    r <- liftIO $ mrun $+            K.foldStreamShared undefined+                (\a r -> do+                    runIn <- askRunInIO+                    toHeap $ AheadEntryStream (runIn, Just a, r))+                (toHeap . AheadEntryPure)+                stopk+                m+    res <- restoreM r+    case res of+        Continue -> workLoopAhead q heap sv winfo+        Suspend -> drainHeap q heap sv winfo++    where++    -- XXX to reduce contention each CPU can have its own heap+    toHeap ent = do+        -- Heap insertion is an expensive affair so we use a non CAS based+        -- modification, otherwise contention and retries can make a thread+        -- context switch and throw it behind other threads which come later in+        -- sequence.+        newHp <- liftIO $ atomicModifyIORef heap $ \(hp, snum) ->+            let hp' = H.insert (Entry seqNo ent) hp+            in assert (heapIsSane snum seqNo) ((hp', snum), hp')++        when (svarInspectMode sv) $+            liftIO $ do+                maxHp <- readIORef (maxHeapSize $ svarStats sv)+                when (H.size newHp > maxHp) $+                    writeIORef (maxHeapSize $ svarStats sv) (H.size newHp)++        heapOk <- liftIO $ underMaxHeap sv newHp++        -- XXX Refactor to use join points+        status <-+            case yieldRateInfo sv of+                Nothing -> return HContinue+                Just yinfo ->+                    case winfo of+                        Just info -> do+                            rateOk <-+                                liftIO+                                    $ incrWorkerYieldCount+                                        (maxWorkerLimit sv)+                                        (workerCount sv)+                                        yinfo+                                        info+                            if rateOk+                            then return HContinue+                            else return HStop+                        Nothing -> return HContinue++        if heapOk+        then+            case status of+                HContinue -> return Continue+                HStop -> return Suspend+        else return Suspend++data TokenWorkerStatus = TokenContinue Int | TokenSuspend++-- XXX Rename to processInOrder++-- | With token means this worker is working on an item which is the next in+-- sequence, therefore, it can be yielded directly to the output queue,+-- avoiding the heap.+--+-- Before suspending the worker has the responsibility to transfer all the+-- in-sequence entries from the heap to the output queue.+processWithToken+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> K.StreamK m a+    -> Int+    -> m ()+processWithToken q heap sv winfo action sno = do+    -- Note, we enter this function with yield limit already decremented+    -- XXX deduplicate stop in all invocations+    let stopk = do+            liftIO (incrementYieldLimit (remainingWork sv))+            return $ TokenContinue (sno + 1)+        mrun = runInIO $ svarMrun sv++    r <-+        liftIO+            $ mrun+            $ K.foldStreamShared+                undefined (yieldOutput sno) (singleOutput sno) stopk action++    res <- restoreM r+    case res of+        TokenContinue seqNo -> loopWithToken seqNo+        TokenSuspend -> drainHeap q heap sv winfo++    where++    singleOutput seqNo a = do+        continue <- liftIO $ yieldWith winfo sv a+        if continue+        then return $ TokenContinue (seqNo + 1)+        else do+            liftIO $ updateHeapSeq heap (seqNo + 1)+            return TokenSuspend++    -- XXX use a wrapper function around stop so that we never miss+    -- incrementing the yield in a stop continuation. Essentiatlly all+    -- "unstream" calls in this function must increment yield limit on stop.+    yieldOutput seqNo a r = do+        continue <- liftIO $ yieldWith winfo sv a+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if continue && yieldLimitOk+        then do+            let stopk = do+                    liftIO (incrementYieldLimit (remainingWork sv))+                    return $ TokenContinue (seqNo + 1)+            K.foldStreamShared undefined+                          (yieldOutput seqNo)+                          (singleOutput seqNo)+                          stopk+                          r+        else do+            runIn <- askRunInIO+            let ent = Entry seqNo (AheadEntryStream (runIn, Nothing, r))+            liftIO $ requeueOnHeapTop heap ent seqNo+            liftIO $ incrementYieldLimit (remainingWork sv)+            return TokenSuspend++    loopWithToken nextSeqNo = do+        let preExit = liftIO $ do+                updateHeapSeq heap nextSeqNo+                incrementYieldLimit (remainingWork sv)+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        -- To avoid a race when another thread puts something+        -- on the heap and goes away, the consumer will not get+        -- a doorBell and we will not clear the heap before+        -- executing the next action. If the consumer depends+        -- on the output that is stuck in the heap then this+        -- will result in a deadlock. So we always clear the+        -- heap before executing the next action.+        if yieldLimitOk+        then do+            -- XXX Instead of checking seqno inside dequeue we can dequeue+            -- unconditionally and if the seqNo is not the same as nextSeqNo+            -- then release the token and call processWithoutToken. Need+            -- to check the performance though.+            work <- dequeueAheadSeqCheck q nextSeqNo+            case work of+                Nothing -> preExit >> workLoopAhead q heap sv winfo+                Just m -> do+                    let stopk = do+                            liftIO (incrementYieldLimit (remainingWork sv))+                            return $ TokenContinue (nextSeqNo + 1)+                        mrun = runInIO $ svarMrun sv+                    r <- liftIO $ mrun $+                        K.foldStreamShared undefined+                                      (yieldOutput nextSeqNo)+                                      (singleOutput nextSeqNo)+                                      stopk+                                      m+                    res <- restoreM r+                    case res of+                        TokenContinue seqNo -> loopWithToken seqNo+                        TokenSuspend -> drainHeap q heap sv winfo+        else preExit >> drainHeap q heap sv winfo++-- XXX the yield limit changes increased the performance overhead by 30-40%.+-- Just like AsyncT we can use an implementation without yeidlimit and even+-- without pacing code to keep the performance higher in the unlimited and+-- unpaced case.+--+-- XXX The yieldLimit stuff is pretty invasive. We can instead do it by using+-- three hooks, a pre-execute hook, a yield hook and a stop hook. In fact these+-- hooks can be used for a more general implementation to even check predicates+-- and not just yield limit.++workLoopAhead+    :: MonadRunInIO m+    => IORef ([K.StreamK m a], Int)+    -> IORef (Heap (Entry Int (AheadHeapEntry m a)), Maybe Int)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopAhead q heap sv winfo = do+        r <- liftIO $ dequeueFromHeap heap+        case r of+            Ready (Entry seqNo hent) ->+                processHeap q heap sv winfo hent seqNo False+            Clearing -> return ()+            Waiting _ -> do+                -- Before we execute the next item from the work queue we check+                -- if we are beyond the yield limit. It is better to check the+                -- yield limit before we pick up the next item. Otherwise we+                -- may have already started more tasks even though we may have+                -- reached the yield limit.  We can avoid this by taking active+                -- workers into account, but that is not as reliable, because+                -- workers may go away without picking up work and yielding a+                -- value.+                --+                -- Rate control can be done either based on actual yields in+                -- the output queue or based on any yield either to the heap or+                -- to the output queue. In both cases we may have one issue or+                -- the other. We chose to do this based on actual yields to the+                -- output queue because it makes the code common to both async+                -- and ahead streams.+                --+                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+                if yieldLimitOk+                then do+                    work <- dequeueAhead q+                    case work of+                        Nothing -> return ()+                        Just (m, seqNo) -> do+                            if seqNo == 0+                            then processWithToken q heap sv winfo m seqNo+                            else processWithoutToken q heap sv winfo m seqNo+                else liftIO $ incrementYieldLimit (remainingWork sv)++-------------------------------------------------------------------------------+-- SVar creation+-- This code belongs in SVar.hs but is kept here for perf reasons+-------------------------------------------------------------------------------++-- XXX we have this function in this file because passing runStreamLIFO as a+-- function argument to this function results in a perf degradation of more+-- than 10%.  Need to investigate what the root cause is.+-- Interestingly, the same thing does not make any difference for Ahead.+-- {-# INLINABLE getLifoSVar #-}+getLifoSVar :: forall m a. MonadRunInIO m =>+    RunInIO m -> Config -> IO (Channel m a)+getLifoSVar mrun cfg = do+    outQ    <- newIORef ([], 0)+    -- The second component of the heap IORef tuple is:+    --+    --  * "Nothing" when we are in the process of clearing the heap i.e. when+    --  we are procssing the heap and transferring entries from the heap to the+    --  output queue+    --  * "Just n" when we are expecting sequence number n to arrive before we+    --  can start clearing the heap.+    outH    <- newIORef (H.empty, Just 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef Set.empty+    q       <- newIORef ([] :: [(RunInIO m, K.StreamK m a)])+    -- Sequence number is incremented whenever something is de-queued,+    -- therefore, first sequence number would be 0+    aheadQ <- newIORef ([], -1)+    stopMVar <- newMVar ()+    yl <-+        case getYieldLimit cfg of+            Nothing -> return Nothing+            Just x -> Just <$> newIORef x+    stoppingRef <- newIORef False+    stoppedMVar <- newMVar False+    rateInfo <- newRateInfo cfg++    stats <- newSVarStats+    tid <- myThreadId++    -- We are reading it without lock, the result would be reliable only if no+    -- worker is pending.+    let isWorkFinished _ = do+            xs <- readIORef q+            return (null xs)++    let isWorkFinishedLimited sv = do+            yieldsDone <-+                    case remainingWork sv of+                        Just ref -> do+                            n <- readIORef ref+                            return (n <= 0)+                        Nothing -> return False+            qEmpty <- isWorkFinished sv+            return $ qEmpty || yieldsDone++    let eagerEval = getEagerDispatch cfg+        inOrder = getOrdered cfg++    let getSVar :: Channel m a+            -> (Channel m a -> m [ChildEvent a])+            -> (Channel m a -> m Bool)+            -> (Channel m a -> IO Bool)+            -> (IORef [(RunInIO m, K.StreamK m a)]+                -> Channel m a+                -> Maybe WorkerInfo+                -> m())+            -> Channel m a+        getSVar sv readOutput postProc workDone wloop = Channel+            { outputQueue      = outQ+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer cfg+            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running++            , workLoop =+                if inOrder+                then workLoopAhead aheadQ outH sv+                else wloop q sv+            , channelStopping = stoppingRef+            , channelStopped = stoppedMVar+            , enqueue =+                    if inOrder+                    then enqueueAhead sv aheadQ+                    else enqueueLIFO sv q+            , eagerDispatch = when eagerEval $ void $ dispatchWorker 0 sv+            , isWorkDone =+                if inOrder+                then isWorkDoneAhead sv aheadQ outH+                else workDone sv+            , isQueueDone =+                if inOrder+                then isQueueDoneAhead sv aheadQ+                else workDone sv++            , doorBellOnWorkQ  = wfw+            , svarMrun         = mrun+            , workerCount      = active+            -- XXX We can use delThread or modThread based on eager flag.+            , accountThread    = modifyThread running outQMv+            , workerStopMVar   = stopMVar+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv =+            case getStreamRate cfg of+                Nothing ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv (readOutputQBounded eagerEval)+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv (readOutputQBounded eagerEval)+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+                Just _  ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopLIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopLIFOLimited+     in return sv++    where++    {-# INLINE isQueueDoneAhead #-}+    isQueueDoneAhead sv q = do+        queueDone <- checkEmpty q+        yieldsDone <-+                case remainingWork sv of+                    Just yref -> do+                        n <- readIORef yref+                        return (n <= 0)+                    Nothing -> return False+        -- XXX note that yieldsDone can only be authoritative only when there+        -- are no workers running. If there are active workers they can+        -- later increment the yield count and therefore change the result.+        return $ yieldsDone || queueDone++    {-# INLINE isWorkDoneAhead #-}+    isWorkDoneAhead sv q ref = do+        heapDone <- do+                (hp, _) <- readIORef ref+                return (H.size hp <= 0)+        queueDone <- isQueueDoneAhead sv q+        return $ heapDone && queueDone++    checkEmpty q = do+        (xs, _) <- readIORef q+        return $ null xs++-- | Create a new async style concurrent stream evaluation channel. The monad+-- state used to run the stream actions is taken from the call site of+-- newAppendChannel.+--+-- This is a low level API, use newChannel instead.+{-# INLINABLE newAppendChannel #-}+{-# SPECIALIZE newAppendChannel :: (Config -> Config) -> IO (Channel IO a) #-}+newAppendChannel :: MonadRunInIO m => (Config -> Config) -> m (Channel m a)+newAppendChannel modifier = do+    mrun <- askRunInIO+    liftIO $ getLifoSVar mrun (modifier defaultConfig)
+ src/Streamly/Internal/Data/Stream/Channel/Consumer.hs view
@@ -0,0 +1,143 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Consumer+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream.Channel.Consumer+    (+    -- *** Reading Events+    -- | Low level functions used to build 'fromChannelK'.+      readOutputQBounded+    , readOutputQPaced+    , postProcessBounded+    , postProcessPaced+    )+where++import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.IORef (readIORef)++import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type++-------------------------------------------------------------------------------+-- Reading from the workers' output queue/buffer+-------------------------------------------------------------------------------++{-# INLINE readOutputQChan #-}+readOutputQChan :: Channel m a -> IO ([ChildEvent a], Int)+readOutputQChan sv = do+    let ss = if svarInspectMode sv then Just (svarStats sv) else Nothing+     in readOutputQRaw (outputQueue sv) ss++-- | Read the channel's output queue. When there is no output dispatches+-- workers and waits for output (using 'sendWorkerWait'). Always ensures that+-- there is at least one outstanding worker.+--+-- To be used as 'readOutputQ' function for the channel.+readOutputQBounded :: MonadIO m => Bool -> Channel m a -> m [ChildEvent a]+readOutputQBounded eagerEval sv = do+    (list, len) <- liftIO $ readOutputQChan sv+    -- When there is no output seen we dispatch more workers to help+    -- out if there is work pending in the work queue.+    if len <= 0+    then blockingRead+    else do+        -- send a worker proactively, if needed, even before we start+        -- processing the output.  This may degrade single processor+        -- perf but improves multi-processor, because of more+        -- parallelism+        sendOneWorker+        return list++    where++    sendOneWorker = do+        cnt <- liftIO $ readIORef $ workerCount sv+        when (cnt <= 0) $ do+            done <- liftIO $ isWorkDone sv+            when (not done) (forkWorker 0 sv)++    {-# INLINE blockingRead #-}+    blockingRead = do+        dispatchAllWait eagerEval sendWorkerDelay (dispatchWorker 0) sv+        liftIO (fst `fmap` readOutputQChan sv)++-- | Same as 'readOutputQBounded' but uses 'dispatchWorkerPaced' to+-- dispatch workers with rate control.+--+-- To be used as 'readOutputQ' function for the channel when rate control is+-- on.+readOutputQPaced :: MonadIO m => Channel m a -> m [ChildEvent a]+readOutputQPaced sv = do+    (list, len) <- liftIO $ readOutputQChan sv+    if len <= 0+    then blockingRead+    else do+        -- XXX send a worker proactively, if needed, even before we start+        -- processing the output.+        void $ dispatchWorkerPaced sv+        return list++    where++    {-# INLINE blockingRead #-}+    blockingRead = do+        dispatchAllWait False sendWorkerDelayPaced dispatchWorkerPaced sv+        liftIO (fst `fmap` readOutputQChan sv)++-- | If there is work to do dispatch as many workers as the target rate+-- requires.+--+-- To be used as 'postProcess' function for the channel when rate control is+-- enabled.+postProcessPaced :: MonadIO m => Channel m a -> m Bool+postProcessPaced sv = do+    workersDone <- allThreadsDone (workerThreads sv)+    -- XXX If during consumption we figure out we are getting delayed then we+    -- should trigger dispatch there as well.  We should try to check on the+    -- workers after consuming every n item from the buffer?+    if workersDone+    then do+        r <- liftIO $ isWorkDone sv+        when (not r) $ do+            void $ dispatchWorkerPaced sv+            -- Note that we need to guarantee a worker since the work is not+            -- finished, therefore we cannot just rely on dispatchWorkerPaced+            -- which may or may not send a worker.+            noWorker <- allThreadsDone (workerThreads  sv)+            when noWorker $ forkWorker 0 sv+        return r+    else return False++-- | If there is work to do ensure that we have at least one worker disptached.+--+-- To be used as 'postProcess' function for the channel.+postProcessBounded :: MonadIO m => Channel m a -> m Bool+postProcessBounded sv = do+    workersDone <- allThreadsDone (workerThreads sv)+    -- There may still be work pending even if there are no workers pending+    -- because all the workers may return if the outputQueue becomes full. In+    -- that case send off a worker to kickstart the work again.+    --+    -- Note that isWorkDone can only be safely checked if all workers are done.+    -- When some workers are in progress they may have decremented the yield+    -- Limit and later ending up incrementing it again. If we look at the yield+    -- limit in that window we may falsely say that it is 0 and therefore we+    -- are done.+    if workersDone+    then do+        r <- liftIO $ isWorkDone sv+        -- Note that we need to guarantee a worker, therefore we cannot just+        -- use dispatchWorker which may or may not send a worker.+        when (not r) (forkWorker 0 sv)+        -- XXX do we need to dispatch many here?+        -- void $ dispatchWorker sv+        return r+    else return False
+ src/Streamly/Internal/Data/Stream/Channel/Dispatcher.hs view
@@ -0,0 +1,509 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Dispatcher+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+module Streamly.Internal.Data.Stream.Channel.Dispatcher+    (+    -- *** Worker Dispatching+    -- | Low level functions used to build readOutputQ and postProcess+    -- functions.+      forkWorker+    , dispatchWorker+    , dispatchWorkerPaced+    , dispatchAllWait+    , sendWorkerDelay+    , sendWorkerDelayPaced+    , startChannel -- XXX bootstrap?+    )+where++import Control.Concurrent (takeMVar, threadDelay, forkOS)+import Control.Exception (assert, catch, mask)+import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Maybe (fromJust, fromMaybe)+import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)+import Streamly.Internal.Control.Concurrent (RunInIO(..))+import Streamly.Internal.Control.ForkIO (rawForkIO)+import Streamly.Internal.Data.Atomics+    (atomicModifyIORefCAS_, storeLoadBarrier)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (MicroSecond64(..), diffAbsTime64, fromRelTime64, toRelTime64)++import Streamly.Internal.Data.Channel.Dispatcher+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Channel.Worker+import Streamly.Internal.Data.Stream.Channel.Type++-------------------------------------------------------------------------------+-- Dispatching workers+-------------------------------------------------------------------------------++-- XXX The old code passed the action and exception handler inside this and+-- only did a fork here. When we passed the channel and added the workerCount+-- update under the mask, many concurrent benchmarks regressed, some+-- drastically improved as well. We did an experiment to directly put this fork+-- code in forkWorker and just push the worker count update inside the mask and+-- that itself caused the entire regression. Also the memory consumption in+-- ConcurrentEager.toNullAp benchmark doubled from 300MB to 600 MB So something+-- fishy going on here which needs to be investigated.+--+{-# INLINE doFork #-}+doFork :: Bool -> Channel m a -> Maybe WorkerInfo -> IO ()+doFork bound chan winfo =+    mask $ \restore -> do+            liftIO $ atomicModifyIORefCAS_ (workerCount chan) $ \n -> n + 1+            when (svarInspectMode chan)+                $ recordMaxWorkers (workerCount chan) (svarStats chan)+            let frk =+                    if bound+                    then forkOS+                    else rawForkIO+                (RunInIO mrun) = svarMrun chan+                act = do+                        restore $ void $ mrun (workLoop chan winfo)+                        stopWith winfo chan+            tid <- frk $ catch act (exceptionWith winfo chan)+            -- In case of lazy dispatch we dispatch workers only from the+            -- consumer thread. In that case it is ok to use addThread here as+            -- it is guaranteed that the thread will be added to the workerSet+            -- before the thread STOP event is processed, because we do both of+            -- these actions in the same consumer thread. However, in case of+            -- eager dispatch we may dispatch workers from workers, in which+            -- case the thread Stop even may get processed before the addThread+            -- occurs, so in that case we have to use modifyThread which+            -- performs a toggle rather than adding or deleting.+            --+            -- XXX We can use addThread or modThread based on eager flag.+            -- XXX Update the dispatcher-to-worker threadId map for debugging+            -- tid <- liftIO myThreadId+            -- liftIO $ putStrLn $ "Dispatcher thread: " ++ show tid+            modThread tid++    where++    modThread = modifyThread (workerThreads chan) (outputDoorBell chan)++-- | Low level API to create a worker. Forks a thread which executes the+-- 'workLoop' of the channel. It does not fork only if the channel is stopped.+{-# NOINLINE forkWorker #-}+forkWorker :: MonadIO m =>+       Count -- ^ max yield limit for the worker+    -> Channel m a+    -> m ()+forkWorker yieldMax sv = do+    -- This allocation matters when significant number of workers are being+    -- sent. We allocate it only when needed.+    --+    -- XXX WorkerInfo is required for maxYields to work even if rate control is+    -- not enabled.+    winfo <-+        case yieldRateInfo sv of+            Nothing -> return Nothing+            Just _ -> liftIO $ do+                cntRef <- newIORef 0+                t <- getTime Monotonic+                lat <- newIORef (0, t)+                return $ Just WorkerInfo+                    { workerYieldMax = yieldMax+                    , workerYieldCount = cntRef+                    , workerLatencyStart = lat+                    }++    stopping <- liftIO $ readIORef (channelStopping sv)+    when (not stopping) $ liftIO $ doFork False sv winfo++-- | Determine the maximum number of workers required based on 'maxWorkerLimit'+-- and 'remainingWork'.+{-# INLINE getEffectiveWorkerLimit #-}+getEffectiveWorkerLimit :: MonadIO m => Channel m a -> m Limit+getEffectiveWorkerLimit sv = do+    let workerLimit = maxWorkerLimit sv+    case remainingWork sv of+        Nothing -> return workerLimit+        Just ref -> do+            n <- liftIO $ readIORef ref+            case yieldRateInfo sv of+                Just _ -> return workerLimit+                Nothing ->+                    return $+                        case workerLimit of+                            Unlimited -> Limited (fromIntegral n)+                            Limited lim -> Limited $ min lim (fromIntegral n)++-- | Determine whether the active threads are more than the max threads we are+-- allowed to dispatch.+{-# INLINE checkMaxThreads #-}+checkMaxThreads :: MonadIO m => Int -> Channel m a -> m Bool+checkMaxThreads active sv = do+    -- Note that we may deadlock if the previous workers (tasks in the+    -- stream) wait/depend on the future workers (tasks in the stream)+    -- executing. In that case we should either configure the maxWorker+    -- count to higher or use parallel style instead of ahead or async+    -- style.+    limit <- getEffectiveWorkerLimit sv+    return+        $ case limit of+            Unlimited -> True+            -- Note that the use of remainingWork and workerCount is not+            -- atomic and the counts may even have changed between reading+            -- and using them here, so this is just approximate logic and+            -- we cannot rely on it for correctness. We may actually+            -- dispatch more workers than required.+            Limited lim -> fromIntegral lim > active++-- | Determine whether we would exceed max buffer if we dispatch more workers+-- based on the current outputQueue size and active workers.+{-# INLINE checkMaxBuffer #-}+checkMaxBuffer :: MonadIO m => Int -> Channel m a -> m Bool+checkMaxBuffer active sv = do+    let limit = maxBufferLimit sv+    case limit of+        Unlimited -> return True+        Limited lim -> do+            (_, n) <- liftIO $ readIORef (outputQueue sv)+            return $ fromIntegral lim > n + active++-- | Higher level API to dispatch a worker, it uses 'forkWorker' to create a+-- worker.+--+-- Dispatches a worker only if all of the following are true:+--+-- * the channel has work to do+-- * max thread count is not reached+-- * max buffer limit is not reached+--+-- It is possible that no worker is dispatched even when there is no+-- outstanding worker - only if any of the following is true:+--+-- * maxBuffer limit is 0+-- * maxThreads limit is set to 0+-- * there is output pending in the output buffer+--+-- In all other cases a worker is guaranteed to be dispatched.+--+dispatchWorker :: MonadIO m =>+       Count -- ^ max yield limit for the worker+    -> Channel m a+    -> m Bool -- ^ can dispatch more workers+dispatchWorker yieldCount sv = do+    -- XXX in case of Ahead streams we should not send more than one worker+    -- when the work queue is done but heap is not done.+    -- XXX Should we have a single abstraction for checking q and+    -- work instead checking the two separately?+    --+    -- Yield count check may not be reliable unless there are no workers+    -- outsanding. If there are no outstanding workers, we are fine. But if+    -- there are outstanding workers, it may return done even if we are not+    -- done yet. But that is fine too as there are outstanding workers and we+    -- cannot block forever in dispatchAllWait.+    done <- liftIO $ isWorkDone sv+    -- Note, "done" may not mean that the work is actually finished if there+    -- are workers active, because there may be a worker which has not yet+    -- queued the leftover work.+    if not done+    then do+        qDone <- liftIO $ isQueueDone sv+        -- This count may be more until the sendStop events are processed.+        active <- liftIO $ readIORef $ workerCount sv+        when (active < 0) $ error "Bug: dispatchWorker active negative"+        if not qDone+        then do+            -- XXX for ahead streams shall we take the heap yields into account+            -- for controlling the dispatch? We should not dispatch if the heap+            -- has already got the limit covered.+            r <- checkMaxThreads active sv+            if r+            then do+                r1 <- checkMaxBuffer active sv+                if r1+                then forkWorker yieldCount sv >> return True+                else return False+            else return False+        else do+            when (active <= 0) $ do+                r <- liftIO $ isWorkDone sv+                when (not r) $ forkWorker 0 sv+            return False+    else return False++-- XXX in case of ahead style stream we need to take the heap size into account+-- because we return the workers on the basis of that which causes a condition+-- where we keep dispatching and they keep returning. So we must have exactly+-- the same logic for not dispatching and for returning.++-- | Like 'dispatchWorker' but with rate control. The number of workers to be+-- dispatched are decided based on the target rate. Uses 'dispatchWorker' to+-- actually dispatch when required. It may block wait until there is time to+-- dispatch.+--+-- It guarantees that if there is no outstanding worker and there is work+-- pending then it dispatches a worker though it may block for some time before+-- it does that depending on the rate goal.+dispatchWorkerPaced :: MonadIO m =>+       Channel m a+    -> m Bool -- ^ True means can dispatch more+dispatchWorkerPaced sv = do+    let yinfo = fromJust $ yieldRateInfo sv+    (svarYields, svarElapsed, wLatency) <- do+        now <- liftIO $ getTime Monotonic+        (yieldCount, baseTime, lat) <-+            liftIO+                $ collectLatency+                    (svarInspectMode sv) (svarStats sv) yinfo False+        let elapsed = fromRelTime64 $ diffAbsTime64 now baseTime+        let latency =+                if lat == 0+                then fromMaybe lat (workerBootstrapLatency yinfo)+                else lat++        return (yieldCount, elapsed, latency)++    if wLatency == 0+    -- Need to measure the latency with a single worker before we can perform+    -- any computation.+    then return False+    else do+        let workerLimit = maxWorkerLimit sv+        let targetLat = svarLatencyTarget yinfo+        let range = svarLatencyRange yinfo+        gainLoss <- liftIO $ readIORef (svarGainedLostYields yinfo)+        let work = estimateWorkers workerLimit svarYields gainLoss svarElapsed+                                   wLatency targetLat range++        -- XXX we need to take yieldLimit into account here. If we are at the+        -- end of the limit as well as the time, we should not be sleeping.+        -- If we are not actually planning to dispatch any more workers we need+        -- to take that in account.+        case work of+            BlockWait s -> do+                assert (s >= 0) (return ())+                -- XXX note that when we return from here we will block waiting+                -- for the result from the existing worker. If that takes too+                -- long we won't be able to send another worker until the+                -- result arrives.+                --+                -- Sleep only if there are no active workers and the+                -- outputQueue is empty, otherwise we will delay reading the+                -- pending output. Note we cannot use workerCount here as it is+                -- not a reliable way to ensure the outputQueue is empty. When+                -- workerCount is 0 we may still have a Stop event waiting in+                -- the outputQueue.+                done <- allThreadsDone (workerThreads sv)+                when done $ void $ do+                    let us = fromRelTime64 (toRelTime64 s) :: MicroSecond64+                    liftIO $ threadDelay (fromIntegral us)+                    dispatchWorker 1 sv+                return False+            PartialWorker yields -> do+                assert (yields > 0) (return ())+                updateGainedLostYields yinfo yields++                done <- allThreadsDone (workerThreads sv)+                when done $ void $ dispatchWorker yields sv+                return False+            ManyWorkers netWorkers yields -> do+                assert (netWorkers >= 1) (return ())+                assert (yields >= 0) (return ())+                updateGainedLostYields yinfo yields++                -- XXX workerPollingInterval is also modified by the+                -- collectLatency call above. Need to reconcile the two.+                let periodRef = workerPollingInterval yinfo+                    ycnt = max 1 $ yields `div` fromIntegral netWorkers+                    period = min ycnt (fromIntegral magicMaxBuffer)++                old <- liftIO $ readIORef periodRef+                when (period < old) $+                    liftIO $ writeIORef periodRef period++                cnt <- liftIO $ readIORef $ workerCount sv+                if cnt < netWorkers+                then do+                    let total = netWorkers - cnt+                        batch = max 1 $ fromIntegral $+                                    minThreadDelay `div` targetLat+                    -- XXX stagger the workers over a period?+                    -- XXX cannot sleep, as that would mean we cannot process+                    -- the outputs. need to try a different mechanism to+                    -- stagger.+                    -- when (total > batch) $+                       -- liftIO $ threadDelay $ nanoToMicroSecs minThreadDelay+                    dispatchN (min total batch)+                else return False++    where++    -- If the absolute value of yields required is more than the svarRateBuffer+    -- then the amount beyond the rate buffer is added to the permanently lost+    -- or gained yields.+    updateGainedLostYields yinfo yields = do+        let buf = fromIntegral $ svarRateBuffer yinfo+        when (yields /= 0 && abs yields > buf) $ do+            let delta =+                   if yields > 0+                   then yields - buf+                   else yields + buf+            liftIO $ modifyIORef (svarGainedLostYields yinfo) (+ delta)++    dispatchN n =+        if n == 0+        then return True+        else do+            r <- dispatchWorker 0 sv+            if r+            then dispatchN (n - 1)+            else return False++-- | Dispatches as many workers as it can until output is seen in the event+-- queue of the channel. If the dispatcher function returns 'False' then no+-- more dispatches can be done. If no more dispatches are possible blocks until+-- output arrives in the event queue.+--+-- When this function returns we are sure that there is some output available.+--+-- Before we call this function we must ensure that there is either a pending+-- worker or pending work, otherwise it might block forever. If there is+-- pending work and no pending worker the dispatcher function must ensure that+-- it dispatches a worker.+--+{-# NOINLINE dispatchAllWait #-}+dispatchAllWait+    :: MonadIO m+    => Bool -- ^ 'eager' option is on+    -> (Channel m a -> IO ()) -- ^ delay function+    -> (Channel m a -> m Bool) -- ^ dispatcher function+    -> Channel m a+    -> m ()+dispatchAllWait eagerEval delay dispatch sv = go++    where++    go = do++        -- Note that we are guaranteed to have at least one outstanding worker+        -- when we enter this function. So if we sleep we are guaranteed to be+        -- woken up by an outputDoorBell, when the worker exits.++        liftIO $ delay sv+        (_, n) <- liftIO $ readIORef (outputQueue sv)+        when (n <= 0 || eagerEval) $ do+            -- The queue may be empty temporarily if the worker has dequeued+            -- the work item but has not enqueued the remaining part yet. For+            -- the same reason, a worker may come back if it tries to dequeue+            -- and finds the queue empty, even though the whole work has not+            -- finished yet.++            -- If we find that the queue is empty, but it may be empty+            -- temporarily, when we checked it. If that's the case we might+            -- sleep indefinitely unless the active workers produce some+            -- output. We may deadlock specially if the otuput from the active+            -- workers depends on the future workers that we may never send.+            -- So in case the queue was temporarily empty set a flag to inform+            -- the enqueue to send us a doorbell.++            -- Note that this is just a best effort mechanism to avoid a+            -- deadlock. Deadlocks may still happen if for some weird reason+            -- the consuming computation shares an MVar or some other resource+            -- with the producing computation and gets blocked on that resource+            -- and therefore cannot do any pushworker to add more threads to+            -- the producer. In such cases the programmer should use a parallel+            -- style so that all the producers are scheduled immediately and+            -- unconditionally. We can also use a separate monitor thread to+            -- push workers instead of pushing them from the consumer, but then+            -- we are no longer using pull based concurrency rate adaptation.+            --+            -- XXX update this in the tutorial.+            --+            -- Having pending active workers does not mean that we are+            -- guaranteed to be woken up if we sleep. In case of Ahead streams,+            -- there may be queued items in the heap even though the+            -- outputQueue is empty, and we may have active workers which are+            -- deadlocked on those items to be processed by the consumer. We+            -- should either guarantee that any worker, before returning,+            -- clears the heap or we send a worker to clear it. Normally we+            -- always send a worker if no output is seen, but if the thread+            -- limit is reached or we are using pacing then we may not send a+            -- worker. See the concurrentApplication test in the tests, that+            -- test case requires at least one yield from the producer to not+            -- deadlock, if the last workers output is stuck in the heap then+            -- this test fails.  This problem can be extended to n threads when+            -- the consumer may depend on the evaluation of next n items in the+            -- producer stream.++            -- register for the outputDoorBell before we check the queue so+            -- that if we sleep because the queue was empty we are guaranteed+            -- to get a doorbell on the next enqueue.++            liftIO $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv) $ const True+            liftIO storeLoadBarrier+            canDoMore <- dispatch sv++            -- XXX test for the case when we miss sending a worker when the+            -- worker count is more than 1500.+            --+            -- XXX Assert here that if the heap is not empty then there is at+            -- least one outstanding worker. Otherwise we could be sleeping+            -- forever.++            if canDoMore+            then go+            else do+                liftIO+                    $ withDiagMVar+                        (svarInspectMode sv)+                        (dumpChannel sv)+                        "dispatchAllWait: nothing to do"+                    $ takeMVar (outputDoorBell sv)+                (_, len) <- liftIO $ readIORef (outputQueue sv)+                if len <= 0+                then go+                else+                    liftIO+                        $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv)+                        $ const False++-- | Start the evaluation of the channel's work queue by kicking off a worker.+-- Note: Work queue must not be empty otherwise the worker will exit without+-- doing anything.+startChannel :: MonadIO m =>+    Channel m a -> m ()+startChannel chan = do+    case yieldRateInfo chan of+        Nothing -> forkWorker 0 chan+        Just yinfo  ->+            if svarLatencyTarget yinfo == maxBound+            then liftIO $ threadDelay maxBound+            else forkWorker 1 chan++-- | Noop as of now.+sendWorkerDelayPaced :: Channel m a -> IO ()+sendWorkerDelayPaced _ = return ()++-- | Noop as of now.+sendWorkerDelay :: Channel m a -> IO ()+sendWorkerDelay _sv =+    -- XXX we need a better way to handle this than hardcoded delays. The+    -- delays may be different for different systems.+    -- If there is a usecase where this is required we can create a combinator+    -- to set it as a config in the state.+    {-+  do+    ncpu <- getNumCapabilities+    if ncpu <= 1+    then+        if (svarStyle sv == AheadVar)+        then threadDelay 100+        else threadDelay 25+    else+        if (svarStyle sv == AheadVar)+        then threadDelay 100+        else threadDelay 10+    -}+    return ()
+ src/Streamly/Internal/Data/Stream/Channel/Interleave.hs view
@@ -0,0 +1,257 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Interleave+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Interleave+    (+      newInterleaveChannel+    )+where++#include "inline.hs"++import Control.Concurrent (myThreadId)+import Control.Concurrent.MVar (newEmptyMVar, newMVar)+import Control.Monad.IO.Class (MonadIO(liftIO))+import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, nullQ, tryPopR, pushL)+import Data.IORef (newIORef, readIORef)+import Streamly.Internal.Control.Concurrent+    (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)+import Streamly.Internal.Data.Channel.Dispatcher (delThread)++import qualified Data.Set as Set+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Consumer+import Streamly.Internal.Data.Stream.Channel.Type++------------------------------------------------------------------------------+-- Creating a channel+------------------------------------------------------------------------------++data WorkerStatus = Continue | Suspend++-- XXX This is not strictly round-robin as the streams that are faster may+-- yield more elements than the ones that are slower. Also, when streams+-- suspend due to buffer getting full they get added to the queue in a random+-- order. Document this under interleaved config option or fix it.++{-# INLINE enqueueFIFO #-}+enqueueFIFO ::+       Channel m a+    -> LinkedQueue (RunInIO m, K.StreamK m a)+    -> (RunInIO m, K.StreamK m a)+    -> IO ()+enqueueFIFO sv q m = do+    pushL q m+    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)++{-# INLINE workLoopFIFO #-}+workLoopFIFO+    :: MonadRunInIO m+    => LinkedQueue (RunInIO m, K.StreamK m a)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFO q sv winfo = run++    where++    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> do+                r <- liftIO+                        $ runin+                        $ K.foldStreamShared+                            undefined yieldk single (return Continue) m+                res <- restoreM r+                case res of+                    Continue -> run+                    Suspend -> return ()++    single a = do+        res <- liftIO $ yieldWith winfo sv a+        return $ if res then Continue else Suspend++    -- XXX in general we would like to yield "n" elements from a single stream+    -- before moving on to the next. Single element granularity could be too+    -- expensive in certain cases. Similarly, we can use time limit for+    -- yielding.+    yieldk a r = do+        res <- liftIO $ yieldWith winfo sv a+        runInIO <- askRunInIO+        -- XXX If the queue is empty we do not need to enqueue. We can just+        -- continue evaluating the stream.+        liftIO $ enqueueFIFO sv q (runInIO, r)+        return $ if res then Continue else Suspend++{-# INLINE workLoopFIFOLimited #-}+workLoopFIFOLimited+    :: forall m a. MonadRunInIO m+    => LinkedQueue (RunInIO m, K.StreamK m a)+    -> Channel m a+    -> Maybe WorkerInfo+    -> m ()+workLoopFIFOLimited q sv winfo = run++    where++    incrContinue =+        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue++    run = do+        work <- liftIO $ tryPopR q+        case work of+            Nothing -> return ()+            Just (RunInIO runin, m) -> do+                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+                if yieldLimitOk+                then do+                    r <- liftIO+                            $ runin+                            $ K.foldStreamShared+                                undefined yieldk single incrContinue m+                    res <- restoreM r+                    case res of+                        Continue -> run+                        Suspend -> return ()+                else liftIO $ do+                    enqueueFIFO sv q (RunInIO runin, m)+                    incrementYieldLimit (remainingWork sv)++    single a = do+        res <- liftIO $ yieldWith winfo sv a+        return $ if res then Continue else Suspend++    yieldk a r = do+        res <- liftIO $ yieldWith winfo sv a+        runInIO <- askRunInIO+        liftIO $ enqueueFIFO sv q (runInIO, r)+        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)+        if res && yieldLimitOk+        then return Continue+        else liftIO $ do+            incrementYieldLimit (remainingWork sv)+            return Suspend++-------------------------------------------------------------------------------+-- SVar creation+-------------------------------------------------------------------------------++-- XXX we have this function in this file because passing runStreamLIFO as a+-- function argument to this function results in a perf degradation of more+-- than 10%.  Need to investigate what the root cause is.+-- Interestingly, the same thing does not make any difference for Ahead.+getFifoSVar :: forall m a. MonadRunInIO m =>+    RunInIO m -> Config -> IO (Channel m a)+getFifoSVar mrun cfg = do+    outQ    <- newIORef ([], 0)+    outQMv  <- newEmptyMVar+    active  <- newIORef 0+    wfw     <- newIORef False+    running <- newIORef Set.empty+    q       <- newQ+    yl      <- case getYieldLimit cfg of+                Nothing -> return Nothing+                Just x -> Just <$> newIORef x+    stoppingRef <- newIORef False+    stoppedMVar <- newMVar False+    rateInfo <- newRateInfo cfg++    stats <- newSVarStats+    tid <- myThreadId++    let isWorkFinished _ = nullQ q+    let isWorkFinishedLimited sv = do+            yieldsDone <-+                    case remainingWork sv of+                        Just ref -> do+                            n <- readIORef ref+                            return (n <= 0)+                        Nothing -> return False+            qEmpty <- nullQ q+            return $ qEmpty || yieldsDone++    let getSVar :: Channel m a+            -> (Channel m a -> m [ChildEvent a])+            -> (Channel m a -> m Bool)+            -> (Channel m a -> IO Bool)+            -> (LinkedQueue (RunInIO m, K.StreamK m a)+                -> Channel m a+                -> Maybe WorkerInfo+                -> m())+            -> Channel m a+        getSVar sv readOutput postProc workDone wloop = Channel+            { outputQueue      = outQ+            , remainingWork    = yl+            , maxBufferLimit   = getMaxBuffer cfg+            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)+            , yieldRateInfo    = rateInfo+            , outputDoorBell   = outQMv+            , readOutputQ      = readOutput sv+            , postProcess      = postProc sv+            , workerThreads    = running+            , workLoop         = wloop q sv+            , channelStopping   = stoppingRef+            , channelStopped   = stoppedMVar+            , enqueue          = enqueueFIFO sv q+            , eagerDispatch    = return ()+            , isWorkDone       = workDone sv+            , isQueueDone      = workDone sv+            , doorBellOnWorkQ  = wfw+            , svarMrun         = mrun+            , workerCount      = active+            , accountThread    = delThread running+            , workerStopMVar   = undefined+            , svarRef          = Nothing+            , svarInspectMode  = getInspectMode cfg+            , svarCreator      = tid+            , svarStats        = stats+            }++    let sv =+            case getStreamRate cfg of+                Nothing ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv (readOutputQBounded False)+                                              postProcessBounded+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv (readOutputQBounded False)+                                              postProcessBounded+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+                Just _  ->+                    case getYieldLimit cfg of+                        Nothing -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinished+                                              workLoopFIFO+                        Just _  -> getSVar sv readOutputQPaced+                                              postProcessPaced+                                              isWorkFinishedLimited+                                              workLoopFIFOLimited+     in return sv++-- XXX GHC: If instead of MonadAsync we use (MonadIO m, MonadBaseControl IO m)+-- constraint we get a 2x perf regression. Need to look into that.++-- | Create a new 'interleaved' style concurrent stream evaluation channel. The+-- monad state used to run the stream actions is taken from the call site of+-- newInterleaveChannel.+--+-- This is a low level API, use newChannel instead.+{-# INLINABLE newInterleaveChannel #-}+{-# SPECIALIZE newInterleaveChannel :: (Config -> Config) -> IO (Channel IO a) #-}+newInterleaveChannel :: MonadAsync m =>+    (Config -> Config) -> m (Channel m a)+newInterleaveChannel modifier = do+    mrun <- askRunInIO+    liftIO $ getFifoSVar mrun (modifier defaultConfig)
+ src/Streamly/Internal/Data/Stream/Channel/Operations.hs view
@@ -0,0 +1,335 @@+#ifdef __HADDOCK_VERSION__+#undef INSPECTION+#endif++#ifdef INSPECTION+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}+#endif++-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Operations+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Operations+    (+    -- *** Reading Stream+      fromChannelK+    , fromChannel++    -- ** Enqueuing Work+    , toChannelK+    , toChannel+    )+where++#include "inline.hs"++import Control.Exception (fromException, displayException)+import Control.Monad (when)+import Control.Monad.Catch (throwM, MonadThrow)+import Control.Monad.IO.Class (MonadIO(liftIO))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import Data.IORef (newIORef, mkWeakIORef, writeIORef)+import Streamly.Internal.Control.Concurrent+    (MonadAsync, MonadRunInIO, askRunInIO)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)++import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K++import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel.Dispatcher+import Streamly.Internal.Data.Stream.Channel.Type hiding (inspect)++import Prelude hiding (map, concat, concatMap)++#ifdef INSPECTION+import Control.Exception (Exception)+import Control.Monad.Trans.Control (MonadBaseControl)+import Data.Typeable (Typeable)+import Test.Inspection (inspect, hasNoTypeClassesExcept)+#endif++------------------------------------------------------------------------------+-- Generating streams from a channel+------------------------------------------------------------------------------++-- $concurrentEval+--+-- Usually a channel is used to concurrently evaluate multiple actions in a+-- stream using many worker threads that push the results to the channel and a+-- single puller that pulls them from channel generating the evaluated stream.+--+-- @+--                  input stream+--                       |+--     <-----------------|<--------worker+--     |  exceptions     |+-- output stream <---Channel<------worker+--                       |+--                       |<--------worker+--+-- @+--+-- The puller itself schedules the worker threads based on demand.+-- Exceptions are propagated from the worker threads to the puller.++-------------------------------------------------------------------------------+-- Write a stream to a channel+-------------------------------------------------------------------------------++-- XXX Should be a Fold, singleton API could be called joinChannel, or the fold+-- can be called joinChannel.+-- XXX If we use toChannelK multiple times on a channel make sure the channel+-- does not go away before we use the subsequent ones.++-- | High level function to enqueue a work item on the channel. The fundamental+-- unit of work is a stream. Each stream enqueued on the channel is picked up+-- and evaluated by a worker thread. The worker evaluates the stream it picked+-- up serially. When multiple streams are queued on the channel each stream can+-- be evaluated concurrently by different workers.+--+-- Note that the items in each stream are not concurrently evaluated, streams+-- are fundamentally serial, therefore, elements in one particular stream will+-- be generated serially one after the other. Only two or more streams can be+-- run concurrently with each other.+--+-- See 'chanConcatMapK' for concurrent evaluation of each element of a stream.+-- Alternatively, you can wrap each element of the original stream into a+-- stream generating action and queue all those streams on the channel. Then+-- all of them would be evaluated concurrently. However, that would not be+-- streaming in nature, it would require buffering space for the entire+-- original stream. Prefer 'chanConcatMapK' for larger streams.+--+-- Items from each evaluated streams are queued to the same output queue of the+-- channel which can be read using 'fromChannelK'. 'toChannelK' can be called+-- multiple times to enqueue multiple streams on the channel.+--+{-# INLINE toChannelK #-}+toChannelK :: MonadRunInIO m => Channel m a -> K.StreamK m a -> m ()+toChannelK chan m = do+    runIn <- askRunInIO+    liftIO $ enqueue chan (runIn, m)++-- INLINE for fromStreamK/toStreamK fusion++-- | A wrapper over 'toChannelK' for 'Stream' type.+{-# INLINE toChannel #-}+toChannel :: MonadRunInIO m => Channel m a -> Stream m a -> m ()+toChannel chan = toChannelK chan . Stream.toStreamK++{-+-- | Send a stream of streams to a concurrent channel for evaluation.+{-# INLINE joinChannel #-}+joinChannel :: Channel m a -> Fold m (Stream m a) ()+joinChannel = undefined+-}++-------------------------------------------------------------------------------+-- Read a stream from a channel+-------------------------------------------------------------------------------++-- | Pull a stream from an SVar.+{-# NOINLINE fromChannelRaw #-}+fromChannelRaw :: (MonadIO m, MonadThrow m) => Channel m a -> K.StreamK m a+fromChannelRaw sv = K.MkStream $ \st yld sng stp -> do+    list <- readOutputQ sv+    -- Reversing the output is important to guarantee that we process the+    -- outputs in the same order as they were generated by the constituent+    -- streams.+    K.foldStream st yld sng stp $ processEvents $ reverse list++    where++    {-# INLINE processEvents #-}+    processEvents [] = K.MkStream $ \st yld sng stp -> do+        done <- postProcess sv+        if done+        then liftIO (channelDone sv "Channel done") >> stp+        else K.foldStream st yld sng stp $ fromChannelRaw sv++    processEvents (ev : es) = K.MkStream $ \st yld sng stp -> do+        let rest = processEvents es+        case ev of+            ChildYield a -> yld a rest+            ChildStopChannel -> do+                liftIO $ cleanupChan sv "ChildStopChannel"+                stp+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> K.foldStream st yld sng stp rest+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                -- We terminate the loop after sending+                                -- ThreadAbort to workers so we should never+                                -- get it unless it is thrown from inside a+                                -- worker thread or by someone else to our+                                -- thread.+                                error $ "processEvents: got ThreadAbort for tid " ++ show tid+                                -- K.foldStream st yld sng stp rest+                            Nothing -> do+                                liftIO $ cleanupChan sv (displayException ex)+                                throwM ex++#ifdef INSPECTION+-- Use of GHC constraint tuple (GHC.Classes.(%,,%)) in fromStreamVar leads to+-- space leak because the tuple gets allocated in every recursive call and each+-- allocation holds on to the previous allocation. This test is to make sure+-- that we do not use the constraint tuple type class.+--+inspect $ hasNoTypeClassesExcept 'fromChannelRaw+    [ ''Monad+    , ''Applicative+    , ''MonadThrow+    , ''Exception+    , ''MonadIO+    , ''MonadBaseControl+    , ''Typeable+    , ''Functor+    ]+#endif++-- XXX Add a lock in the channel so that fromChannel cannot be called multiple+-- times.+--+-- XXX Add an option to block the consumer rather than stopping the stream if+-- the work queue gets over.++-- | Draw a stream from a concurrent channel. The stream consists of the+-- evaluated values from the input streams that were enqueued on the channel+-- using 'toChannelK'.+--+-- This is the event processing loop for the channel which does two+-- things, (1) dispatch workers, (2) process the events sent by the workers.+-- Workers are dispatched based on the channel's configuration settings.+--+-- The stream stops and the channel is shutdown if any of the following occurs:+--+-- * the work queue becomes empty+-- * channel's max yield limit is reached+-- * an exception is thrown by a worker+-- * 'shutdown' is called on the channel+--+-- Before the channel stops, all the workers are drained and no more workers+-- are dispatched. When the channel is garbage collected a 'ThreadAbort'+-- exception is thrown to all pending workers. If 'inspect' option is enabled+-- then channel's stats are printed on stdout when the channel stops.+--+-- CAUTION! This API must not be called more than once on a channel.+{-# INLINE fromChannelK #-}+fromChannelK :: MonadAsync m =>+    Maybe (IO () -> IO ()) -> Channel m a -> K.StreamK m a+fromChannelK register chan =+    -- Note: when an explicit cleanup handler registration is used, we still+    -- install a GC based cleanup handler, in case the explicit cleanup handler+    -- is not called by the user we will still clean it up when it is garbage+    -- collected.+    K.mkStream $ \st yld sng stp -> do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref (cleanupChan chan "Channel cleanup via GC")+        let msg = "Channel cleanup via explicit handler"++        -- Register the cleanup handler to be called at the end of a user+        -- defined bracket.+        --+        -- IMPORTANT: this hook should run before the resource cleanup hooks+        -- registered by the worker threads themselves. If the auto release+        -- hooks registered by the workers run first then we might release the+        -- resources which are potentially in use by the workers, thus the+        -- workers may misbehave. The correct sequence is to first abort and+        -- drain all the workers then run any hooks registered by them.++        case register of+            Nothing -> return ()+            Just f -> liftIO $ f (cleanupChan chan msg)++        startChannel chan+        -- We pass a copy of chan to fromChannelRaw, with svarRef set to ref,+        -- so that we know that it has no other references, when that copy gets+        -- garbage collected "ref" will get garbage collected and our hook will+        -- be called.+        --+        -- XXX We should install cleanupChan as the exception handler for+        -- ThreadAbort or any async exception while running fromChannelRaw.+        K.foldStreamShared st yld sng stp $+            fromChannelRaw chan{svarRef = Just ref}++-- | A wrapper over 'fromChannelK' for 'Stream' type.+{-# INLINE fromChannel #-}+fromChannel :: MonadAsync m => Channel m a -> Stream m a+-- XXX Pass the cleanup registration function to fromChannelK+fromChannel = Stream.fromStreamK . fromChannelK Nothing++#if __GLASGOW_HASKELL__ >= 810+type FromSVarState :: Type -> (Type -> Type) -> Type -> Type+#endif+data FromSVarState t m a =+      FromSVarInit+    | FromSVarRead (Channel m a)+    | FromSVarLoop (Channel m a) [ChildEvent a]+    | FromSVarDone (Channel m a)++-- | Like 'fromSVar' but generates a StreamD style stream instead of CPS.+--+{-# INLINE_NORMAL _fromChannelD #-}+_fromChannelD :: (MonadIO m, MonadThrow m) => Channel m a -> D.Stream m a+_fromChannelD svar = D.Stream step FromSVarInit+    where++    {-# INLINE_LATE step #-}+    step _ FromSVarInit = do+        ref <- liftIO $ newIORef ()+        _ <- liftIO $ mkWeakIORef ref (cleanupChan svar "Channel cleanup via GC")+        -- when this copy of svar gets garbage collected "ref" will get+        -- garbage collected and our GC hook will be called.+        let sv = svar{svarRef = Just ref}+        return $ D.Skip (FromSVarRead sv)++    step _ (FromSVarRead sv) = do+        list <- readOutputQ sv+        -- Reversing the output is important to guarantee that we process the+        -- outputs in the same order as they were generated by the constituent+        -- streams.+        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)++    step _ (FromSVarLoop sv []) = do+        done <- postProcess sv+        return $ D.Skip $ if done+                      then FromSVarDone sv+                      else FromSVarRead sv++    step _ (FromSVarLoop sv (ev : es)) = do+        case ev of+            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)+            ChildStopChannel -> do+                liftIO $ cleanupChan sv "ChildStopChannel"+                return $ D.Skip (FromSVarDone sv)+            ChildStop tid e -> do+                accountThread sv tid+                case e of+                    Nothing -> return $ D.Skip (FromSVarLoop sv es)+                    Just ex ->+                        case fromException ex of+                            Just ThreadAbort ->+                                return $ D.Skip (FromSVarLoop sv es)+                            Nothing -> do+                                liftIO $ cleanupChan sv (displayException ex)+                                throwM ex++    step _ (FromSVarDone sv) = do+        when (svarInspectMode sv) $ do+            t <- liftIO $ getTime Monotonic+            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)+            liftIO $ printSVar (dumpChannel sv) "SVar Done"+        return D.Stop
+ src/Streamly/Internal/Data/Stream/Channel/Type.hs view
@@ -0,0 +1,887 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Channel.Type+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Channel.Type+    (+    -- ** Type+      Channel(..)++    -- ** Configuration+    , Config++    -- *** Default config+    , defaultConfig++    -- *** Limits+    , maxThreads+    , maxBuffer+    , maxYields++    -- *** Rate Control+    , Rate(..)+    , newRateInfo+    , rate+    , avgRate+    , minRate+    , maxRate+    , constRate++    -- *** Stop behavior+    , StopWhen (..)+    , stopWhen++    -- *** Scheduling behavior+    , eager+    , ordered+    , interleaved+    , boundThreads++    -- *** Diagnostics+    , inspect++    -- *** Resource management+    , useAcquire+    , clearAcquire++    -- *** Get config+    , getMaxBuffer+    , getMaxThreads+    , getYieldLimit+    , getInspectMode+    , getStreamRate+    , getEagerDispatch+    , getOrdered+    , getStopWhen+    , getInterleaved+    , getCleanup++    -- ** Sending Worker Events+    , yieldWith+    , stopWith+    , exceptionWith+    , shutdown++    -- ** Cleanup+    , channelDone+    , cleanupChan++    -- ** Diagnostics+    , dumpChannel+    )+where++import Control.Concurrent (ThreadId, throwTo, takeMVar, putMVar)+import Control.Concurrent.MVar (MVar)+import Control.Exception (SomeException(..))+import Control.Monad (void, when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Int (Int64)+import Data.IORef (IORef, newIORef, readIORef, atomicWriteIORef, writeIORef)+import Data.List (intersperse)+import Data.Set (Set)+import Streamly.Internal.Control.Concurrent (RunInIO)+import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS)+import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)+import Streamly.Internal.Data.Channel.Worker+    (sendYield, sendStop, sendEvent, sendException)+import Streamly.Internal.Data.StreamK (StreamK)+import Streamly.Internal.Control.Exception+    (AcquireIO(..), Priority(..), registerWith)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units (NanoSecond64(..))+import System.Mem (performMajorGC)++import qualified Data.Set as Set++import Streamly.Internal.Data.Channel.Types++-- IMPORTANT NOTE: we cannot update the SVar after generating it as we have+-- references to the original SVar stored in several functions which will keep+-- pointing to the original data and the new updates won't reflect there.+-- Any updateable parts must be kept in mutable references (IORef).++-- XXX Since we have stream specific channels now, we can remove functions like+-- enqueue, readOuputQ, postProcess, workLoop etc from this.++-- XXX Add an option in channel for minthreads.+-- dispatch tail worker from the worker itself up to min threads or based on+-- pace data. min threads can be increased dynamically by the event loop.+-- for eager minthreads = maxthreads++-- | A mutable channel to evaluate multiple streams concurrently and provide+-- the combined results as output stream.+--+-- There are only two actors working on the channel data structure, the event+-- processing loop (single thread), and the workers (multiple threads). Locking+-- notes are provided below for concurrent access.+data Channel m a = Channel+    {+     -- XXX Do we need this? We store the runner in the work q, is that enough?+     -- This seems to be used only by the 'ordered' stream as of now.++     -- | Runner for the monadic actions in the stream. Captures the monad+     -- state at the point where the channel was created and uses the same+     -- state to run all actions.+      svarMrun :: RunInIO m++    ---------------------------------------------------------------------------+    -- Output queue related+    ---------------------------------------------------------------------------++    -- | Maximum size of the 'outputQueue'. The actual worst case buffer could+    -- be double of this as the event loop may read the queue and the workers+    -- may fill it up even before the event loop has started consuming.+    , maxBufferLimit :: Limit++    -- XXX For better efficiency we can try a preallocated array type (perhaps+    -- something like a vector) that allows an O(1) append. That way we will+    -- avoid constructing and reversing the list. Possibly we can also avoid+    -- the GC copying overhead. When the size increases we should be able to+    -- allocate the array in chunks.+    --+    -- XXX We can use a per-CPU data structure to reduce the locking overhead.+    -- However, a per-cpu structure cannot guarantee the exact sequence in+    -- which the elements were added, though that may not be important.+    --+    -- XXX We can send a bundle of events of one type coaleseced together in an+    -- unboxed structure.++    -- | (events, count): worker event queue of the channel. This is where the+    -- workers queue the results and other events.+    --+    -- [LOCKING] Frequently locked. This is locked and updated by workers on+    -- each yield, and locked, updated by the event loop thread once in a while+    -- for reading. Workers' locking contention may be high if there are a+    -- large number of workers.+    , outputQueue :: IORef ([ChildEvent a], Int)++    -- | Door bell for workers to wakeup the event loop.+    --+    -- [LOCKING] Infrequently locked. Used only when the 'outputQueue'+    -- transitions from empty to non-empty, or a work item is queued by a+    -- worker to the work queue and 'doorBellOnWorkQ' is set by the event loop.+    --+    -- We also use this for workerCount decrement, we wait on this during+    -- cleanup. So any workerCount decrement must send a doorBell.+    , outputDoorBell :: MVar ()++    -- XXX Can we use IO instead of m here?++    -- | Function to read the output queue of the channel, depends on the rate+    -- control option.+    , readOutputQ :: m [ChildEvent a]++    -- | Function to invoke after all the events read in a batch are processed+    -- i.e. before we go on to read the next batch, depends on the rate control+    -- option.+    , postProcess :: m Bool++    ---------------------------------------------------------------------------+    -- Work and rate control+    ---------------------------------------------------------------------------++    -- | Tracks how many yields are remaining before the channel stops, used+    -- when 'maxYields' option is enabled.+    --+    -- [LOCKING] Read only access by event loop when dispatching a worker.+    -- Decremented by workers when picking work and undo decrement if the+    -- worker does not yield a value.+    , remainingWork :: Maybe (IORef Count)++    -- XXX We make this isChannelDone which should not include isQueueDone.+    --+    -- | Determine if there is no more work to do. When 'maxYields' is set for+    -- the channel we may be done even if the work queue still has work.+    , isWorkDone :: IO Bool++    -- | Rate control information for the channel used when 'rate' control is+    -- enabled,+    , yieldRateInfo :: Maybe YieldRateInfo++    ---------------------------------------------------------------------------+    -- Work queue related+    ---------------------------------------------------------------------------++    -- | When set to True, ring 'outputDoorBell' when a work item is queued on+    -- the work queue. This is set by the dispatcher before going to sleep. It+    -- wants to be woken up whenever the work queue got more work to do so that+    -- it can dispatch a worker.+    , doorBellOnWorkQ :: IORef Bool++    -- XXX instead of this we should use a dispatcher setting.++    -- | This is a hook which is invoked whenever the tail of the stream is+    -- re-enqueued on the work queue. Normally, this is set to a noop. When+    -- 'eager' option is enabled this is set to an unconditional worker+    -- dispatch function. This ensures that we eagerly send a worker as long+    -- as there is work to do.+    --+    -- NOTE that this is called from a worker context, therefore we should+    -- consider appropriate locking semantics.+    , eagerDispatch :: m ()++    -- | Enqueue a stream for evaluation on the channel. The first element of+    -- the tuple is the runner function which is used to run the stream actions+    -- in a specific monadic context.+    , enqueue :: (RunInIO m, StreamK m a) -> IO ()++    -- | Determine if the work queue is empty, therefore, there is no more work+    -- to do.+    , isQueueDone :: IO Bool++    -- | Worker function. It is implicitly aware of the work queue. It dequeues+    -- a work item from the queue and runs it. It keeps on doing this in a loop+    -- until it determines that it needs to stop.+    --+    -- Normally, the worker stops when the work queue becomes empty or the work+    -- rate is higher than the target rate when rate control is enabled. It+    -- stops by sending a 'ChildStop' event to the channel+    --+    -- When rate control is enabled, the worker is dispatched with a+    -- 'WorkerInfo' record which is used by the worker to maintain rate control+    -- information and communicate it to the channel.+    , workLoop :: Maybe WorkerInfo -> m ()++    , channelStopping :: IORef Bool+    , channelStopped :: MVar Bool++    ---------------------------------------------------------------------------+    -- Worker thread accounting+    ---------------------------------------------------------------------------+    --+    -- | This is capped to 'maxBufferLimit' if set to more than that. Otherwise+    -- potentially each worker may yield one value to the buffer in the worst+    -- case exceeding the requested buffer size.+    , maxWorkerLimit :: Limit++    -- | Tracks all active worker threads. An entry is added by the dispatcher+    -- when a worker is dispatched, and removed whenever the event processing+    -- loop receives a 'ChildStop' event.+    --+    -- [LOCKING] Normally, this is updated only by the event loop thread, but+    -- in case of eager dispatch (done in worker context) it is updated by a+    -- worker. So reads from the event loop should be mindful of that.+    -- Updates to this must be async signal safe because we rely on it for+    -- cleanup and cleanup may leave unfinished threads if a thread is forked+    -- but this is not updated.+    , workerThreads :: IORef (Set ThreadId)++    -- | Total number of active worker threads.+    --+    -- [LOCKING] Updated locked, by the event loop thread when dispatching a+    -- worker and by a worker thread when the thread stops. This is read+    -- without lock at several places where we want to rely on an approximate+    -- value. Updates to this must be async signal safe because we rely on it+    -- for cleanup and cleanup may hang and leave unfinished threads if this is+    -- not correct.+    , workerCount :: IORef Int++    -- XXX Can we use IO instead of m here?+    , accountThread  :: ThreadId -> m ()++    -- | Used when 'ordered' is enabled. This is a lock to stop the workers one+    -- at a time. Stopping one might affect whether the other should stop.+    , workerStopMVar :: MVar ()++    ---------------------------------------------------------------------------+    -- Channel cleanup --+    ---------------------------------------------------------------------------+    -- | A weak IORef to call a cleanup function when the channel is garbage+    -- collected.+    , svarRef :: Maybe (IORef ())++    ---------------------------------------------------------------------------+    -- Channel Stats --+    ---------------------------------------------------------------------------+    -- | Stats collection.+    , svarStats :: SVarStats++    ---------------------------------------------------------------------------+    -- Diagnostics --+    ---------------------------------------------------------------------------+    -- | When 'inspect' mode is enabled we report diagnostic data about the+    -- channel at certain points.+    , svarInspectMode :: Bool+    -- | threadId of the thread that created the channel+    , svarCreator :: ThreadId++    -- XXX Add a map of dispatcher thread to worker thread.+    }++-------------------------------------------------------------------------------+-- Channel Config+-------------------------------------------------------------------------------++-- XXX we can put the resettable fields in a oneShotConfig field and others in+-- a persistentConfig field. That way reset would be fast and scalable+-- irrespective of the number of fields.+--+-- XXX make all these Limited types and use phantom types to distinguish them++-- | An abstract type for specifying the configuration parameters of a+-- 'Channel'. Use @Config -> Config@ modifier functions to modify the default+-- configuration. See the individual modifier documentation for default values.+--+data Config = Config+    { -- one shot configuration, automatically reset for each API call+      -- streamVar   :: Maybe (SVar t m a)+      _yieldLimit  :: Maybe Count++    -- persistent configuration, state that remains valid until changed by+    -- an explicit setting via a combinator.+    , _threadsHigh    :: Limit+    , _bufferHigh     :: Limit++    -- XXX these two can be collapsed into a single type+    , _streamLatency  :: Maybe NanoSecond64 -- bootstrap latency+    , _maxStreamRate  :: Maybe Rate+    , _inspect    :: Bool+    , _eagerDispatch  :: Bool+    , _stopWhen :: StopWhen+    , _ordered :: Bool+    , _interleaved :: Bool+    , _bound :: Bool++    -- XXX We can also use resource-t to release the channel. But that will+    -- require a MonadResource constraint. It is a bigger change, we can plan+    -- in future. With MonadResource, runResourceT will have to be called to+    -- create a scope. Here we have an option to use prompt release or GC+    -- release, but there are chances of missing a prompt release when the+    -- option is provided to the programmer instead of always enforcing it.+    --+    -- We could store Channel m a, here instead of a deallocation function, if+    -- we make the Config type as "Config m a". That way we can also share+    -- channels across multiple computations.+    , _release :: Maybe (IO () -> IO ())+    }++-------------------------------------------------------------------------------+-- State defaults and reset+-------------------------------------------------------------------------------++defaultMaxThreads, defaultMaxBuffer :: Limit+defaultMaxThreads = Limited magicMaxBuffer+defaultMaxBuffer = Limited magicMaxBuffer++-- | The fields prefixed by an _ are not to be accessed or updated directly but+-- via smart accessor APIs. Use get/set routines instead of directly accessing+-- the Config fields+defaultConfig :: Config+defaultConfig = Config+    { -- streamVar = Nothing+      _yieldLimit = Nothing+    , _threadsHigh = defaultMaxThreads+    , _bufferHigh = defaultMaxBuffer+    , _maxStreamRate = Nothing+    , _streamLatency = Nothing+    , _inspect = False+    -- XXX Set it to True when Rate is not set?+    , _eagerDispatch = False+    , _stopWhen = AllStop+    , _ordered = False+    , _interleaved = False+    , _bound = False+    , _release = Nothing+    }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++-- | The maximum number of yields that this channel would produce. The Channel+-- automatically stops after that. This could be used to limit the speculative+-- execution beyond the limit.+--+-- 'Nothing' means there is no limit.+--+-- Keep in mind that checking this limit all the time has a performance+-- overhead.+--+-- Known Bugs: currently this works only when rate is specified.+-- Known Bugs: for ordered streams sometimes the actual count is less than+-- expected.+maxYields :: Maybe Int64 -> Config -> Config+maxYields lim st =+    st { _yieldLimit =+            case lim of+                Nothing -> Nothing+                Just n  ->+                    if n <= 0+                    then Just 0+                    else Just (fromIntegral n)+       }++getYieldLimit :: Config -> Maybe Count+getYieldLimit = _yieldLimit++-- | Specify the maximum number of threads that can be spawned by the channel.+-- A value of 0 resets the thread limit to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- When the actions in a stream are IO bound, having blocking IO calls, this+-- option can be used to control the maximum number of in-flight IO requests.+-- When the actions are CPU bound this option can be used to control the amount+-- of CPU used by the stream.+--+maxThreads :: Int -> Config -> Config+maxThreads n st =+    st { _threadsHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxThreads+                 else Limited (fromIntegral n)+       }++getMaxThreads :: Config -> Limit+getMaxThreads = _threadsHigh++-- | Specify the maximum size of the buffer for storing the results from+-- concurrent computations. If the buffer becomes full we stop spawning more+-- concurrent tasks until there is space in the buffer.+-- A value of 0 resets the buffer size to default, a negative value means+-- there is no limit. The default value is 1500.+--+-- CAUTION! using an unbounded 'maxBuffer' value (i.e. a negative value)+-- coupled with an unbounded 'maxThreads' value is a recipe for disaster in+-- presence of infinite streams, or very large streams.  Especially, it must+-- not be used when 'pure' is used in 'ZipAsyncM' streams as 'pure' in+-- applicative zip streams generates an infinite stream causing unbounded+-- concurrent generation with no limit on the buffer or threads.+--+maxBuffer :: Int -> Config -> Config+maxBuffer n st =+    st { _bufferHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxBuffer+                 else Limited (fromIntegral n)+       }++getMaxBuffer :: Config -> Limit+getMaxBuffer = _bufferHigh++-- | Specify the stream evaluation rate of a channel.+--+-- A 'Nothing' value means there is no smart rate control, concurrent execution+-- blocks only if 'maxThreads' or 'maxBuffer' is reached, or there are no more+-- concurrent tasks to execute. This is the default.+--+-- When rate (throughput) is specified, concurrent production may be ramped+-- up or down automatically to achieve the specified stream throughput. The+-- specific behavior for different styles of 'Rate' specifications is+-- documented under 'Rate'.  The effective maximum production rate achieved by+-- a channel is governed by:+--+-- * The 'maxThreads' limit+-- * The 'maxBuffer' limit+-- * The maximum rate that the stream producer can achieve+-- * The maximum rate that the stream consumer can achieve+--+-- Maximum production rate is given by:+--+-- \(rate = \frac{maxThreads}{latency}\)+--+-- If we know the average latency of the tasks we can set 'maxThreads'+-- accordingly.+--+rate :: Maybe Rate -> Config -> Config+rate r st = st { _maxStreamRate = r }++getStreamRate :: Config -> Maybe Rate+getStreamRate = _maxStreamRate++_setStreamLatency :: Int -> Config -> Config+_setStreamLatency n st =+    st { _streamLatency =+            if n <= 0+            then Nothing+            else Just (fromIntegral n)+       }++getStreamLatency :: Config -> Maybe NanoSecond64+getStreamLatency = _streamLatency++-- XXX Rename to "inspect"++-- | Print debug information about the 'Channel' when the stream ends. When the+-- stream does not end normally, the channel debug information is printed when+-- the channel is garbage collected. If you are expecting but not seeing the+-- debug info try adding a 'performMajorGC' before the program ends.+--+inspect :: Bool -> Config -> Config+inspect flag st = st { _inspect = flag }++getInspectMode :: Config -> Bool+getInspectMode = _inspect++-- | By default, processing of output from the worker threads is given priority+-- over dispatching new workers. More workers are dispatched only when there is+-- no output to process. When 'eager' is set to 'True', workers are dispatched+-- aggresively as long as there is more work to do irrespective of whether+-- there is output pending to be processed by the stream consumer. However,+-- dispatching may stop if 'maxThreads' or 'maxBuffer' is reached.+--+-- /Note:/ This option has no effect when rate has been specified.+--+-- /Note:/ Not supported with 'interleaved'.+--+eager :: Bool -> Config -> Config+eager flag st = st { _eagerDispatch = flag }++getEagerDispatch :: Config -> Bool+getEagerDispatch = _eagerDispatch++-- | Specify when the 'Channel' should stop.+stopWhen :: StopWhen -> Config -> Config+stopWhen cond st = st { _stopWhen = cond }++getStopWhen :: Config -> StopWhen+getStopWhen = _stopWhen++-- | When enabled the streams may be evaluated cocnurrently but the results are+-- produced in the same sequence as a serial evaluation would produce.+--+-- /Note:/ Not supported with 'interleaved'.+--+ordered :: Bool -> Config -> Config+ordered flag st = st { _ordered = flag }++getOrdered :: Config -> Bool+getOrdered = _ordered++-- | Interleave the streams fairly instead of prioritizing the left stream.+-- This schedules all streams in a round robin fashion over limited number of+-- threads.+--+-- /Note:/ Can only be used on finite number of streams.+--+-- /Note:/ Not supported with 'ordered'.+--+interleaved :: Bool -> Config -> Config+interleaved flag st = st { _interleaved = flag }++getInterleaved :: Config -> Bool+getInterleaved = _interleaved++-- | Spawn bound threads (i.e., spawn threads using 'forkOS' instead of+-- 'forkIO'). The default value is 'False'.+--+-- /Unimplemented/+boundThreads :: Bool -> Config -> Config+boundThreads flag st = st { _bound = flag }++_getBound :: Config -> Bool+_getBound = _bound++-- | A concurrent stream allocates worker threads to evaluates actions in the+-- stream concurrently. When an exception (sync or async) occurs in the code+-- outside the scope of the stream generation code, these workers need to be+-- stopped promptly. To enable that we can use an 'AcquireIO' bracket from the+-- surrounding scope. When 'AcquireIO' scope ends the channel is automatically+-- cleaned up.+--+-- Here is an example:+--+-- >>> import Control.Monad (when)+-- >>> import Control.Concurrent (threadDelay)+-- >>> import Data.Function ((&))+-- >>> import System.IO (hClose, IOMode(..), openFile)+--+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>> import qualified Streamly.Control.Exception as Exception+--+-- >>> :{+-- close x h = do+--  putStrLn $ "closing: " ++ x+--  hClose h+-- :}+--+-- >>> :{+-- action ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.parMapM (Stream.useAcquire ref)+--        (\x -> do+--            (h, release) <- Exception.acquire ref (openFile x ReadMode) (close x)+--            -- use h here+--            threadDelay 1000000+--            when (x == "file1") $ do+--                putStrLn $ "Manually releasing: " ++ x+--                release+--            return x+--        )+--    & Stream.trace print+--    & Stream.fold Fold.drain+-- :}+--+-- >>> run = Exception.withAcquireIO action+--+useAcquire :: AcquireIO -> Config -> Config+useAcquire f cfg = cfg { _release = Just (registerWith Priority1 f) }++-- | Clear the resource release registration function.+clearAcquire :: Config -> Config+clearAcquire cfg = cfg { _release = Nothing }++getCleanup :: Config -> Maybe (IO () -> IO ())+getCleanup = _release++-------------------------------------------------------------------------------+-- Initialization+-------------------------------------------------------------------------------++newRateInfo :: Config -> IO (Maybe YieldRateInfo)+newRateInfo st = do+    -- convert rate in Hertz to latency in Nanoseconds+    let rateToLatency r = if r <= 0 then maxBound else round $ 1.0e9 / r+    case getStreamRate st of+        Just (Rate low goal high buf) ->+            let l    = rateToLatency goal+                minl = rateToLatency high+                maxl = rateToLatency low+            in mkYieldRateInfo l (LatencyRange minl maxl) buf+        Nothing -> return Nothing++    where++    mkYieldRateInfo latency latRange buf = do+        measured <- newIORef 0+        wcur     <- newIORef (0,0,0)+        wcol     <- newIORef (0,0,0)+        now      <- getTime Monotonic+        wlong    <- newIORef (0,now)+        period   <- newIORef 1+        gainLoss <- newIORef (Count 0)++        return $ Just YieldRateInfo+            { svarLatencyTarget      = latency+            , svarLatencyRange       = latRange+            , svarRateBuffer         = buf+            , svarGainedLostYields   = gainLoss+            , workerBootstrapLatency = getStreamLatency st+            , workerPollingInterval  = period+            , workerMeasuredLatency  = measured+            , workerPendingLatency   = wcur+            , workerCollectedLatency = wcol+            , svarAllTimeLatency     = wlong+            }++-------------------------------------------------------------------------------+-- Rate+-------------------------------------------------------------------------------++-- | Same as @rate (Just $ Rate (r/2) r (2*r) maxBound)@+--+-- Specifies the average production rate of a stream in number of yields+-- per second (i.e.  @Hertz@).  Concurrent production is ramped up or down+-- automatically to achieve the specified average yield rate. The rate can+-- go down to half of the specified rate on the lower side and double of+-- the specified rate on the higher side.+--+avgRate :: Double -> Config -> Config+avgRate r = rate (Just $ Rate (r/2) r (2*r) maxBound)++-- | Same as @rate (Just $ Rate r r (2*r) maxBound)@+--+-- Specifies the minimum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go below the+-- specified rate, even though it may possibly go above it at times, the+-- upper limit is double of the specified rate.+--+minRate :: Double -> Config -> Config+minRate r = rate (Just $ Rate r r (2*r) maxBound)++-- | Same as @rate (Just $ Rate (r/2) r r maxBound)@+--+-- Specifies the maximum rate at which the stream should yield values. As+-- far as possible the yield rate would never be allowed to go above the+-- specified rate, even though it may possibly go below it at times, the+-- lower limit is half of the specified rate. This can be useful in+-- applications where certain resource usage must not be allowed to go+-- beyond certain limits.+--+maxRate :: Double -> Config -> Config+maxRate r = rate (Just $ Rate (r/2) r r maxBound)++-- | Same as @rate (Just $ Rate r r r 0)@+--+-- Specifies a constant yield rate. If for some reason the actual rate+-- goes above or below the specified rate we do not try to recover it by+-- increasing or decreasing the rate in future.  This can be useful in+-- applications like graphics frame refresh where we need to maintain a+-- constant refresh rate.+--+constRate :: Double -> Config -> Config+constRate r = rate (Just $ Rate r r r 0)++-------------------------------------------------------------------------------+-- Operations+-------------------------------------------------------------------------------++-- | Used by workers to send a value to the channel's output stream.+--+-- When a worker is dispatched, a 'WorkerInfo' record is supplied to it by the+-- dispatcher. This record contains the timestamp at the time of dispatch.+-- Whenever the worker yields a value, the yield count in the 'WorkerInfo' is+-- incremented. If the channel has rate control enabled, the yield count and+-- time duration is periodically (based on 'workerPollingInterval') pushed to+-- the channel's 'workerPendingLatency' stat. It is done only if the+-- 'workerPollingInterval' is non-zero.+--+-- Queues the event but returns 'False' if:+--+-- * the buffer limit is exceeding+-- * channel yield rate is exceeding (when rate control is enabled and+-- 'WorkerInfo' is available)+--+-- This is a thread-safe API and can be called by anyone from anywhere. Even a+-- thread that is not registered as a worker with the channel can use it but+-- when rate control is enabled, it might confuse the rate control mechanism if+-- we use workers beyond the knowledge of dispatcher.+--+{-# INLINE yieldWith #-}+yieldWith ::+       Maybe WorkerInfo -- ^ Rate control info for the worker+    -> Channel m a+    -> a+    -> IO Bool -- ^ True means the worker can continue otherwise stop.+yieldWith winfo chan =+    sendYield+        (maxBufferLimit chan)+        (maxWorkerLimit chan)+        (workerCount chan)+        (yieldRateInfo chan)+        (outputQueue chan)+        (outputDoorBell chan)+        winfo++-- | Send a 'ChildStop' event to the channel, used when the worker stops+-- yielding and exits. The final update of the collected latency stats in+-- 'WorkerInfo' is pushed to the channel. Upon receiving the 'ChildStop' event+-- the channel would remove the worker from its set of registered workers.+--+-- A worker that uses this API must have been registered on the Channel prior+-- to invoking this API. This is usually done by the dispatcher  when the+-- worker is dispatched.+{-# INLINE stopWith #-}+stopWith :: Maybe WorkerInfo -> Channel m a -> IO ()+stopWith winfo chan =+    sendStop+        (workerCount chan)+        (yieldRateInfo chan)+        (outputQueue chan)+        (outputDoorBell chan)+        winfo++-- | Like 'stopWith' but marks the stop event with the specified exception.+{-# INLINE exceptionWith #-}+exceptionWith :: Maybe WorkerInfo -> Channel m a -> SomeException -> IO ()+exceptionWith _winfo chan =+    sendException+        (workerCount chan)+        (outputQueue chan)+        (outputDoorBell chan)++-- | Send a 'ChildStopChannel' event to shutdown the channel. Upon receiving+-- the event the event processing loop kills all the registered worker threads+-- and stops the channel.+{-# INLINABLE shutdown #-}+shutdown :: MonadIO m => Channel m a -> m ()+shutdown chan = liftIO $ do+    void+        $ sendEvent+            (outputQueue chan)+            (outputDoorBell chan)+            ChildStopChannel++-- | Dump the channel stats for diagnostics. Used when 'inspect' option is+-- enabled.+{-# NOINLINE dumpChannel #-}+dumpChannel :: Channel m a -> IO String+dumpChannel sv = do+    xs <- sequence $ intersperse (return "\n")+        [ return (dumpCreator (svarCreator sv))+        , return "---------CURRENT STATE-----------"+        , dumpOutputQ (outputQueue sv)+        -- XXX print the types of events in the outputQueue, first 5+        , dumpDoorBell (outputDoorBell sv)+        , dumpNeedDoorBell (doorBellOnWorkQ sv)+        , dumpRunningThreads (workerThreads sv)+        -- XXX print the status of first 5 threads+        , dumpWorkerCount (workerCount sv)+        , return "---------STATS-----------\n"+        , dumpSVarStats (svarInspectMode sv) (yieldRateInfo sv) (svarStats sv)+        ]+    return $ concat xs++-------------------------------------------------------------------------------+-- Cleanup+-------------------------------------------------------------------------------++channelDone :: Channel m a -> String -> IO ()+channelDone chan reason = do+    when (svarInspectMode chan) $ do+        t <- getTime Monotonic+        writeIORef (svarStopTime (svarStats chan)) (Just t)+        printSVar (dumpChannel chan) reason+        -- If there are any other channels referenced by this channel a GC will+        -- prompt them to be cleaned up quickly.+        performMajorGC++-- XXX Handle ThreadAbort while this is running?++-- | Never called from a worker thread. This can be called multiple times and+-- only one will succeed others will block until it finishes.+--+cleanupChan :: Channel m a -> String -> IO ()+cleanupChan chan reason = do+    stopped <- takeMVar (channelStopped chan)+    when (not stopped) $ do+        -- putStrLn "cleanupChan: START"+        atomicWriteIORef (channelStopping chan) True+        go+        channelDone chan reason+        putMVar (channelStopped chan) True+        -- putStrLn "cleanupChan: DONE"++    where++    go = do+        -- Empty the queue so that any new results put the doorbell MVar+        _ <- readOutputQBasic (outputQueue chan)+        cnt <- readIORef (workerCount chan)+        -- Note that the workerSet may not have the threadIds of those workers+        -- which are in the process of dispatch but not yet dispatched. To+        -- ensure that we have aborted all the workers we need to wait until+        -- the worker count drops down to zero, until then we need to watch the+        -- workerset and send ThreadAbort if we find any ThreadId in it. As of+        -- now, this can only happen in the eagerDispatch case as we can+        -- dispatch workers from workers in that case.+        workers <-+            atomicModifyIORefCAS (workerThreads chan) (\x -> (Set.empty,x))+        -- self <- myThreadId+        Prelude.mapM_ (`throwTo` ThreadAbort)+              -- (Prelude.filter (/= self) $ Set.toList workers)+              (Set.toList workers)+        {-+        let setSize = Set.size workers+        putStrLn $ "cleanupChan: thread count: " ++ show cnt+                ++ " workerSet size: " ++ show setSize+        -}+        when (cnt /= 0) $ do+            {-+                withDiagMVar+                    (svarInspectMode chan)+                    (dumpChannel chan)+                    "cleanupChan"+                $ -}+            takeMVar (outputDoorBell chan)+            -- threadDelay 10000+            go
src/Streamly/Internal/Data/Stream/Concurrent.hs view
@@ -5,33 +5,24 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC------ Non-parallelizable stream combinators like unfoldrM, iterateM etc. can be--- evaluated concurrently with the stream consumer by using `eval`.--- Parallelizable combinators like repeatM, replicateM can generate the stream--- concurrently using 'concatMap'.  -- Single effects related functionality can be moved to -- Data.Async/Control.Async.--- Common Channel functionality to Data.Channel.--- Stream channel to Data.Stream.Channel.  module Streamly.Internal.Data.Stream.Concurrent     (     -- * Imports     -- $setup -      module Streamly.Internal.Data.Stream.Concurrent.Channel-     -- * Types-    , MonadAsync+      MonadAsync -- XXX Move in channel?      -- * Combinators     -- | Stream combinators using a concurrent channel      -- ** Evaluate     -- | Evaluates a stream concurrently using a channel.-    , parEval+    , parBuffered     -- Add unfoldrM/iterateM?      -- ** Generate@@ -64,43 +55,51 @@      -- ** Stream of streams     -- *** Apply-    , parApply+    , parCrossApply      -- *** Concat     -- | Shares a single channel across many streams.     , parConcat     , parConcatMap+    , parMergeMap      -- *** ConcatIterate     , parConcatIterate+    , parMergeIterate      -- ** Reactive+    , newStreamAndCallback+    , parYieldWith     , fromCallback     , parTapCount     , tapCount++    -- ** Deprecated+    , parEval+    , parApply     ) where  #include "inline.hs"+#include "deprecation.h"  import Control.Concurrent (myThreadId, killThread) import Control.Monad (void, when) import Control.Monad.IO.Class (MonadIO(liftIO))-import Streamly.Internal.Control.Concurrent (MonadAsync, askRunInIO)+import Streamly.Internal.Control.Concurrent (MonadAsync) import Streamly.Internal.Control.ForkLifted (forkManaged) import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)-import Streamly.Internal.Data.Channel.Types (ChildEvent(..))-import Streamly.Internal.Data.Channel.Worker (sendWithDoorBell)+import Streamly.Internal.Data.Channel.Worker (sendEvent) import Streamly.Internal.Data.Stream (Stream, Step(..))-import Streamly.Internal.Data.SVar.Type (adaptState) -import qualified Streamly.Internal.Data.MutArray as Unboxed+import qualified Streamly.Internal.Data.IORef as Unboxed import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.StreamK as K  import Prelude hiding (mapM, sequence, concat, concatMap, zipWith)-import Streamly.Internal.Data.Stream.Concurrent.Channel+import Streamly.Internal.Data.Channel.Types+import Streamly.Internal.Data.Stream.Channel  -- $setup --@@ -113,8 +112,8 @@ -- >>> import qualified Streamly.Data.Fold as Fold -- >>> import qualified Streamly.Data.Parser as Parser -- >>> import qualified Streamly.Data.StreamK as StreamK--- >>> import qualified Streamly.Internal.Data.Stream as Stream hiding (append2)--- >>> import qualified Streamly.Internal.Data.Stream.Concurrent as Stream+-- >>> import qualified Streamly.Internal.Data.Stream as Stream+-- >>> import qualified Streamly.Internal.Data.Stream.Prelude as Stream -- >>> import Prelude hiding (concatMap, concat, zipWith) -- >>> :{ --  delay n = do@@ -128,9 +127,9 @@ -------------------------------------------------------------------------------  {--{-# INLINE_NORMAL parEvalD #-}-parEvalD :: MonadAsync m => (Config -> Config) -> D.Stream m a -> D.Stream m a-parEvalD modifier m = D.Stream step Nothing+{-# INLINE_NORMAL parBufferedD #-}+parBufferedD :: MonadAsync m => (Config -> Config) -> D.Stream m a -> D.Stream m a+parBufferedD modifier m = D.Stream step Nothing     where      step _ Nothing = do@@ -147,14 +146,14 @@             D.Stop      -> D.Stop -} --- | 'parEval' evaluates a stream as a whole asynchronously with respect to+-- | 'parBuffered' evaluates a stream as a whole asynchronously with respect to -- the consumer of the stream. A worker thread evaluates multiple elements of -- the stream ahead of time and buffers the results; the consumer of the stream -- runs in another thread consuming the elements from the buffer, thus--- decoupling the production and consumption of the stream. 'parEval' can be+-- decoupling the production and consumption of the stream. 'parBuffered' can be -- used to run different stages of a pipeline concurrently. ----- It is important to note that 'parEval' does not evaluate individual actions+-- It is important to note that 'parBuffered' does not evaluate individual actions -- in the stream concurrently with respect to each other, it merely evaluates -- the stream serially but in a different thread than the consumer thread, -- thus the consumer and producer can run concurrently. See 'parMapM' and@@ -163,16 +162,18 @@ -- The evaluation requires only one thread as only one stream needs to be -- evaluated. Therefore, the concurrency options that are relevant to multiple -- streams do not apply here e.g. maxThreads, eager, interleaved, ordered,--- stopWhen options do not have any effect on 'parEval'.+-- stopWhen options do not have any effect on 'parBuffered'. -- -- Useful idioms: ----- >>> parUnfoldrM step = Stream.parEval id . Stream.unfoldrM step--- >>> parIterateM step = Stream.parEval id . Stream.iterateM step-{-# INLINE parEval #-}-parEval :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a-parEval modifier input = withChannel modifier input (const id)-    -- Stream.fromStreamD $ parEvalD cfg $ Stream.toStreamD stream+-- >>> parUnfoldrM step = Stream.parBuffered id . Stream.unfoldrM step+-- >>> parIterateM step = Stream.parBuffered id . Stream.iterateM step+{-# INLINE parBuffered #-}+parBuffered, parEval+    :: MonadAsync m => (Config -> Config) -> Stream m a -> Stream m a+parBuffered modifier input = withChannel modifier input (const id)+    -- Stream.fromStreamD $ parBufferedD cfg $ Stream.toStreamD stream+RENAME(parEval,parBuffered)  ------------------------------------------------------------------------------- -- combining two streams@@ -192,7 +193,7 @@     action = do         chan <- newChan modifier         let cfg = modifier defaultConfig-            done = K.nilM (stopChannel chan)+            done = K.nilM (shutdown chan)         case getStopWhen cfg of             AllStop -> do                 toChannelK chan stream2@@ -265,107 +266,6 @@         $ appendWithK             modifier (Stream.toStreamK stream1) (Stream.toStreamK stream2) ----------------------------------------------------------------------------------- Evaluator------------------------------------------------------------------------------------ | @concatMapDivK useTail useHead stream@, divides the stream in head and--- tail, maps a stream generator on the head and maps an action on the tail of--- a stream. Returns the stream generated by the head.------ Used for concurrent evaluation of streams using a Channel.-{-# INLINE concatMapDivK #-}-concatMapDivK :: Monad m =>-       (K.StreamK m a -> m ())-    -> (a -> K.StreamK m b)-    -> K.StreamK m a-    -> K.StreamK m b-concatMapDivK useTail useHead stream =-    K.mkStream $ \st yld sng stp -> do-        let foldShared = K.foldStreamShared st yld sng stp-            single a = foldShared $ useHead a-            yieldk a r = useTail r >> single a-         in K.foldStreamShared (adaptState st) yieldk single stp stream------------------------------------------------------------------------------------ concat streams------------------------------------------------------------------------------------ | A runner function takes a queuing function @q@ and a stream, it splits the--- input stream, queuing the tail and using the head to generate a stream.--- 'mkEnqueue' takes a runner function and generates the queuing function @q@.--- Note that @q@ and the runner are mutually recursive, mkEnqueue ties the knot--- between the two.-{-# INLINE mkEnqueue #-}-mkEnqueue :: MonadAsync m =>-    Channel m b-    -> ((K.StreamK m a -> m ()) -> K.StreamK m a -> K.StreamK m b)-    -> m (K.StreamK m a -> m ())-mkEnqueue chan runner = do-    runInIO <- askRunInIO-    return-        $ let q stream = do-                -- Enqueue the outer loop-                liftIO $ enqueue chan False (runInIO, runner q stream)-                -- XXX In case of eager dispatch we can just directly dispatch-                -- a worker with the tail stream here rather than first queuing-                -- and then dispatching a worker which dequeues the work. The-                -- older implementation did a direct dispatch here and its perf-                -- characterstics looked much better.-                eagerDispatch chan-           in q---- | Takes the head element of the input stream and queues the tail of the--- stream to the channel, then maps the supplied function on the head and--- evaluates the resulting stream.------ This function is designed to be used by worker threads on a channel to--- concurrently map and evaluate a stream.-{-# INLINE parConcatMapChanK #-}-parConcatMapChanK :: MonadAsync m =>-    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b-parConcatMapChanK chan f stream =-   let run q = concatMapDivK q f-    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)-    -- K.parConcatMap (_appendWithChanK chan) f stream--{-# INLINE parConcatMapChanKAny #-}-parConcatMapChanKAny :: MonadAsync m =>-    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b-parConcatMapChanKAny chan f stream =-   let done = K.nilM (stopChannel chan)-       run q = concatMapDivK q (\x -> K.append (f x) done)-    in K.concatMapEffect (`run` stream) (mkEnqueue chan run)--{-# INLINE parConcatMapChanKFirst #-}-parConcatMapChanKFirst :: MonadAsync m =>-    Channel m b -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b-parConcatMapChanKFirst chan f stream =-   let done = K.nilM (stopChannel chan)-       run q = concatMapDivK q f-    in K.concatEffect $ do-        res <- K.uncons stream-        case res of-            Nothing -> return K.nil-            Just (h, t) -> do-                q <- mkEnqueue chan run-                q t-                return $ K.append (f h) done--{-# INLINE parConcatMapChanKGeneric #-}-parConcatMapChanKGeneric :: MonadAsync m =>-       (Config -> Config)-    -> Channel m b-    -> (a -> K.StreamK m b)-    -> K.StreamK m a-    -> K.StreamK m b-parConcatMapChanKGeneric modifier chan f stream = do-        let cfg = modifier defaultConfig-        case getStopWhen cfg of-            AllStop -> parConcatMapChanK chan f stream-            FirstStops -> parConcatMapChanKFirst chan f stream-            AnyStops -> parConcatMapChanKAny chan f stream- -- XXX Add a deep evaluation variant that evaluates individual elements in the -- generated streams in parallel. @@ -376,7 +276,7 @@ parConcatMapK :: MonadAsync m =>     (Config -> Config) -> (a -> K.StreamK m b) -> K.StreamK m a -> K.StreamK m b parConcatMapK modifier f input =-    let g = parConcatMapChanKGeneric modifier+    let g = chanConcatMapK modifier      in withChannelK modifier input (`g` f)  -- | Map each element of the input to a stream and then concurrently evaluate@@ -438,6 +338,15 @@         $ parConcatMapK             modifier (Stream.toStreamK . f) (Stream.toStreamK stream) +-- | Same as 'mergeMapWith interleave' but concurrent.+--+-- /Unimplemented/+--+{-# INLINE parMergeMap #-}+parMergeMap :: -- MonadAsync m =>+    (Config -> Config) -> (a -> Stream m b) -> Stream m a -> Stream m b+parMergeMap _modifier _f _stream = undefined+ -- | Evaluate the streams in the input stream concurrently and combine them. -- -- >>> parConcat modifier = Stream.parConcatMap modifier id@@ -451,6 +360,8 @@ -- concat Lists ------------------------------------------------------------------------------- +-- XXX Rename to parListCat?+ -- | Like 'parConcat' but works on a list of streams. -- -- >>> parList modifier = Stream.parConcat modifier . Stream.fromList@@ -516,18 +427,21 @@ -- Applicative ------------------------------------------------------------------------------- +-- XXX Rename to parStreamApply?+ -- | Apply an argument stream to a function stream concurrently. Uses a -- shared channel for all individual applications within a stream application.-{-# INLINE parApply #-}-{-# SPECIALIZE parApply ::+{-# INLINE parCrossApply #-}+{-# SPECIALIZE parCrossApply ::    (Config -> Config) -> Stream IO (a -> b) -> Stream IO a -> Stream IO b #-}-parApply :: MonadAsync m =>+parCrossApply, parApply :: MonadAsync m =>     (Config -> Config) -> Stream m (a -> b) -> Stream m a -> Stream m b-parApply modifier stream1 stream2 =+parCrossApply modifier stream1 stream2 =     parConcatMap         modifier         (\g -> parConcatMap modifier (Stream.fromPure . g) stream2)         stream1+RENAME(parApply,parCrossApply)  ------------------------------------------------------------------------------- -- Map@@ -571,13 +485,13 @@ -- | Evaluates the streams being zipped in separate threads than the consumer. -- The zip function is evaluated in the consumer thread. ----- >>> parZipWithM cfg f m1 m2 = Stream.zipWithM f (Stream.parEval cfg m1) (Stream.parEval cfg m2)+-- >>> parZipWithM cfg f m1 m2 = Stream.zipWithM f (Stream.parBuffered cfg m1) (Stream.parBuffered cfg m2) -- -- Multi-stream concurrency options won't apply here, see the notes in--- 'parEval'.+-- 'parBuffered'. -- -- If you want to evaluate the zip function as well in a separate thread, you--- can use a 'parEval' on 'parZipWithM'.+-- can use a 'parBuffered' on 'parZipWithM'. -- {-# INLINE parZipWithM #-} parZipWithM :: MonadAsync m@@ -586,7 +500,8 @@     -> Stream m a     -> Stream m b     -> Stream m c-parZipWithM cfg f m1 m2 = Stream.zipWithM f (parEval cfg m1) (parEval cfg m2)+parZipWithM cfg f m1 m2 =+    Stream.zipWithM f (parBuffered cfg m1) (parBuffered cfg m2)  -- | -- >>> parZipWith cfg f = Stream.parZipWithM cfg (\a b -> return $ f a b)@@ -609,7 +524,7 @@ -- -- Definition: ----- >>> parMergeByM cfg f m1 m2 = Stream.mergeByM f (Stream.parEval cfg m1) (Stream.parEval cfg m2)+-- >>> parMergeByM cfg f m1 m2 = Stream.mergeByM f (Stream.parBuffered cfg m1) (Stream.parBuffered cfg m2) -- {-# INLINE parMergeByM #-} parMergeByM :: MonadAsync m@@ -618,7 +533,8 @@     -> Stream m a     -> Stream m a     -> Stream m a-parMergeByM cfg f m1 m2 = Stream.mergeByM f (parEval cfg m1) (parEval cfg m2)+parMergeByM cfg f m1 m2 =+    Stream.mergeByM f (parBuffered cfg m1) (parBuffered cfg m2)  -- | Like 'mergeBy' but evaluates both the streams concurrently. --@@ -654,13 +570,22 @@      where -    iterateStream channel =-        parConcatMapChanKGeneric modifier channel (generate channel)+    iterateStream chan = chanConcatMapK modifier chan (generate chan) -    generate channel x =-        -- XXX The channel q should be FIFO for DFS, otherwise it is BFS-        x `K.cons` iterateStream channel (Stream.toStreamK $ f x)+    -- XXX The channel q should be FIFO for DFS, otherwise it is BFS+    generate chan x = x `K.cons` iterateStream chan (Stream.toStreamK $ f x) +-- | Same as 'mergeIterateWith interleave' but concurrent.+--+-- /Unimplemented/+{-# INLINE parMergeIterate #-}+parMergeIterate :: -- MonadAsync m =>+       (Config -> Config)+    -> (a -> Stream m a)+    -> Stream m a+    -> Stream m a+parMergeIterate _modifier _f _input = undefined+ ------------------------------------------------------------------------------- -- Generate -------------------------------------------------------------------------------@@ -710,9 +635,9 @@ -- -- /Pre-release/ ---{-# INLINE_NORMAL newCallbackStream #-}-newCallbackStream :: MonadAsync m => m (a -> m (), Stream m a)-newCallbackStream = do+{-# INLINE_NORMAL newStreamAndCallback #-}+newStreamAndCallback :: MonadAsync m => m (a -> m (), Stream m a)+newStreamAndCallback = do     chan <- newChannel (eager True)      -- XXX Add our own thread-id to the SVar as we can not know the callback's@@ -727,37 +652,66 @@     let callback a =             liftIO                 $ void-                $ sendWithDoorBell+                $ sendEvent                     (outputQueue chan) (outputDoorBell chan) (ChildYield a)     -- XXX Use fromChannelD?     return (callback, fromChannel chan) --- XXX Rename this to parSetCallback. Also take the Channel config as argument.--- What config can be set by user here?------ XXX What happens if an exception occurs when evaluating the stream? The--- result of callback can be used to communicate that. But we can only know--- about the exception on the next callback call. For better handling the user--- can supply an exception sender function as argument to fromCallback.+-- XXX Take the Channel config as argument.  What config can be set by user+-- here? --- | @fromCallback f@ creates an entangled pair of a callback and a stream i.e.--- whenever the callback is called a value appears in the stream. The function--- @f@ is invoked with the callback as argument, and the stream is returned.--- @f@ would store the callback for calling it later for generating values in--- the stream.+-- | @fromCallback action@ runs @action@ with a callback which is used by+-- the action to send values that appear in the resulting stream. The action+-- must be run in a separate thread independent of the one in which the stream+-- is being evaluated. The action is supposed to be run forever in an infinite+-- loop. ----- The callback queues a value to a concurrent channel associated with the--- stream. The stream can be evaluated safely in any thread.+-- Example: --+-- >> import Control.Concurrent (threadDelay, forkIO)+-- >> import Control.Monad (void, forever)+-- >> import qualified Streamly.Data.Fold as Fold+-- >> import qualified Streamly.Data.Stream.Prelude as Stream+-- >>+-- >> main = do+-- >>     Stream.fold (Fold.drainMapM print)+-- >>         $ Stream.fromCallback+-- >>         $ \yield ->+-- >>             void $ forkIO $ forever $ do+-- >>                 yield "x" >> threadDelay 1000000+-- -- /Pre-release/ -- {-# INLINE fromCallback #-} fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> Stream m a fromCallback setCallback = Stream.concatEffect $ do-    (callback, stream) <- newCallbackStream+    (callback, stream) <- newStreamAndCallback     setCallback callback     return stream +-- XXX What happens if an exception occurs when evaluating the stream? The+-- result of callback can be used to communicate that. But we can only know+-- about the exception on the next callback call. For better handling the user+-- can supply an exception sender function as argument to fromCallback. Or+-- maybe we should just forward all exceptions the parent stream.+--+-- XXX Add a serial version of this i.e. yieldWith?+-- XXX For folds a parAwaitWith is possible.+-- XXX For pipes parYieldAwaitWith++-- | An improved version of 'fromCallback'.+--+-- * Takes a channel config modifier+-- * Evaluates the action in a parallel thread+-- * The action is supplied with a yield function to yield values to the stream+-- * Any exception generated is forwarded to the stream+-- * Sends a Stop event when the action is done.+--+-- /Unimplemented/+parYieldWith :: -- MonadAsync m =>+    (Config -> Config) -> ((a -> m b) -> m c) -> Stream m a+parYieldWith = undefined+ -- | @parTapCount predicate fold stream@ taps the count of those elements in -- the stream that pass the @predicate@. The resulting count stream is sent to -- a @fold@ running concurrently in another thread.@@ -792,7 +746,7 @@         countVar <- liftIO $ Unboxed.newIORef (0 :: Int)         tid <- forkManaged             $ void $ fld-            $ Unboxed.pollIntIORef countVar+            $ Unboxed.pollIORefInt countVar         return $ Skip (Just (countVar, tid, state))      step' gst (Just (countVar, tid, st)) = do@@ -887,7 +841,7 @@ parTap :: MonadAsync m => (Stream m a -> m b) -> Stream m a -> Stream m a parTap f m = undefined --- Can we just use a parEval fold in tap?+-- Can we just use a parBuffered fold in tap? -- We can easily convert the Fold to "Stream m a -> m b" form. Check if this -- provides the same perf as above. {-# INLINE parTap #-}
− src/Streamly/Internal/Data/Stream/Concurrent/Channel.hs 
@@ -1,109 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Concurrent.Channel-    (-      module Streamly.Internal.Data.Stream.Concurrent.Channel.Type-    , module Streamly.Internal.Data.Stream.Concurrent.Channel.Operations-    , module Streamly.Internal.Data.Stream.Concurrent.Channel.Append-    , module Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave-    , module Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-    , module Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer--    -- * Channel-    , Channel (..)-    , newChannel-    , withChannel-    , withChannelK-    -- quiesceChannel -- wait for running tasks but do not schedule any more.--    -- * Configuration-    , Config-    , defaultConfig--    -- ** Limits-    , maxThreads-    , maxBuffer--    -- ** Rate Control-    , Rate(..)-    , rate-    , avgRate-    , minRate-    , maxRate-    , constRate--    -- ** Stop behavior-    , StopWhen (..)-    , stopWhen-    , getStopWhen--    -- ** Scheduling behavior-    , eager-    , ordered-    , interleaved--    -- ** Diagnostics-    , inspect-    )-where--import Streamly.Internal.Control.Concurrent (MonadAsync)-import Streamly.Internal.Data.Stream (Stream)--import qualified Streamly.Internal.Data.StreamK as K--import Streamly.Internal.Data.Channel.Types--import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Stream.Concurrent.Channel.Operations-import Streamly.Internal.Data.Stream.Concurrent.Channel.Append-import Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave-import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer---- | Create a new concurrent stream evaluation channel. The monad--- state used to run the stream actions is captured from the call site of--- newChannel.-{-# INLINE newChannel #-}-newChannel :: MonadAsync m =>-    (Config -> Config) -> m (Channel m a)-newChannel modifier =-    let cfg = modifier defaultConfig-     in if getInterleaved cfg-        then newInterleaveChannel modifier-        else newAppendChannel modifier---- | Allocate a channel and evaluate the stream using the channel and the--- supplied evaluator function. The evaluator is run in a worker thread.-{-# INLINE withChannelK #-}-withChannelK :: MonadAsync m =>-       (Config -> Config)-    -> K.StreamK m a-    -> (Channel m b -> K.StreamK m a -> K.StreamK m b)-    -> K.StreamK m b-withChannelK modifier input evaluator = K.concatEffect action--    where--    action = do-        chan <- newChannel modifier-        toChannelK chan (evaluator chan input)-        return $ fromChannelK chan---- | Allocate a channel and evaluate the stream using the channel and the--- supplied evaluator function. The evaluator is run in a worker thread.-{-# INLINE withChannel #-}-withChannel :: MonadAsync m =>-       (Config -> Config)-    -> Stream m a-    -> (Channel m b -> Stream m a -> Stream m b)-    -> Stream m b-withChannel modifier input evaluator =-    let f chan stream = K.fromStream $ evaluator chan (K.toStream stream)-     in K.toStream $ withChannelK modifier (K.fromStream input) f
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Append.hs 
@@ -1,1046 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Append--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ The functions in this module are separated from the combinators using--- these because of a GHC issue. We need to have newAppendChannel specialized but--- not inlined. If we keep it in the same module as its users we cannot achieve--- that and the code becomes bloated. But if it is in a separate module we can--- use INLINABLE and SPECIALIZE on it which makes it specialized but it is not--- actually inlined.--module Streamly.Internal.Data.Stream.Concurrent.Channel.Append-    (-      newAppendChannel-    )-where--import Control.Concurrent (myThreadId)-import Control.Concurrent.MVar (newEmptyMVar, newMVar, putMVar, takeMVar)-import Control.Exception (assert)-import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.Heap (Heap, Entry(..))-import Data.IORef (IORef, newIORef, readIORef, atomicModifyIORef, writeIORef)-import Data.Kind (Type)-import GHC.Exts (inline)-import Streamly.Internal.Control.Concurrent-    (MonadRunInIO, RunInIO(..), askRunInIO, restoreM)-import Streamly.Internal.Data.Atomics-    (atomicModifyIORefCAS, atomicModifyIORefCAS_)-import Streamly.Internal.Data.Channel.Dispatcher (modifyThread)--import qualified Data.Heap as H-import qualified Data.Set as Set-import qualified Streamly.Internal.Data.StreamK as K--import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer-import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Types-import Streamly.Internal.Data.Channel.Worker----------------------------------------------------------------------------------- Concurrent streams with first-come-first serve results----------------------------------------------------------------------------------- Note: For purely right associated expressions this queue should have at most--- one element. It grows to more than one when we have left associcated--- expressions. Large left associated compositions can grow this to a--- large size-{-# INLINE enqueueLIFO #-}-enqueueLIFO ::-      Channel m a-   -> IORef ([(RunInIO m, K.StreamK m a)], [(RunInIO m, K.StreamK m a)])-   -> Bool-   -> (RunInIO m, K.StreamK m a)-   -> IO ()-enqueueLIFO sv q inner m = do-    atomicModifyIORefCAS_ q $ \(xs, ys) ->-        if inner then (xs, m : ys) else (m : xs, ys)-    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)--data QResult a = QEmpty | QOuter a | QInner a--{-# INLINE dequeue #-}-dequeue :: MonadIO m =>-       IORef ([(RunInIO m, K.StreamK m a)], [(RunInIO m, K.StreamK m a)])-    -> m (QResult (RunInIO m, K.StreamK m a))-dequeue qref =-    liftIO-        $ atomicModifyIORefCAS qref-        $ \case-            (xs, y : ys) -> ((xs, ys), QInner y)-            (x : xs, ys) -> ((xs, ys), QOuter x)-            x -> (x, QEmpty)--data WorkerStatus = Continue | Suspend--{-# INLINE workLoopLIFO #-}-workLoopLIFO-    :: MonadRunInIO m-    => IORef ([(RunInIO m, K.StreamK m a)], [(RunInIO m, K.StreamK m a)])-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-workLoopLIFO qref sv winfo = run--    where--    run = do-        work <- dequeue qref-        case work of-            QEmpty ->-                liftIO $ stop sv winfo-            QInner (RunInIO runin, m) ->-                process runin m True-            QOuter (RunInIO runin, m) ->-                process runin m False--    process runin m inner = do-        -- XXX when we finish we need to send the monadic state back to-        -- the parent so that the state can be merged back. We capture-        -- and return the state in the stop continuation.-        ---        -- Instead of using the run function we can just restore the-        -- monad state here. That way it can work easily for-        -- distributed case as well.-        r <- liftIO $ runin $-                K.foldStreamShared-                    undefined-                    yieldk-                    single-                    (return Continue)-                    m-        res <- restoreM r-        case res of-            Continue -> run-            Suspend -> liftIO $ stop sv winfo--        where--        single a = do-            res <- liftIO $ yield sv winfo a-            return $ if res then Continue else Suspend--        yieldk a r = do-            res <- liftIO $ yield sv winfo a-            if res-            then K.foldStreamShared undefined yieldk single (return Continue) r-            else do-                runInIO <- askRunInIO-                liftIO $ enqueueLIFO sv qref inner (runInIO, r)-                return Suspend---- We duplicate workLoop for yield limit and no limit cases because it has--- around 40% performance overhead in the worst case.------ XXX we can pass yinfo directly as an argument here so that we do not have to--- make a check every time.-{-# INLINE workLoopLIFOLimited #-}-workLoopLIFOLimited-    :: forall m a. MonadRunInIO m-    => IORef ([(RunInIO m, K.StreamK m a)], [(RunInIO m, K.StreamK m a)])-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-workLoopLIFOLimited qref sv winfo = run--    where--    incrContinue =-        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue--    run = do-        work <- dequeue qref-        case work of-            QEmpty ->-                liftIO $ stop sv winfo-            QInner item ->-                process item True-            QOuter item ->-                process item False--    process item@(RunInIO runin, m) inner = do-        -- XXX This is just a best effort minimization of concurrency-        -- to the yield limit. If the stream is made of concurrent-        -- streams we do not reserve the yield limit in the constituent-        -- streams before executing the action. This can be done-        -- though, by sharing the yield limit ref with downstream-        -- actions via state passing. Just a todo.-        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-        if yieldLimitOk-        then do-            r <- liftIO $ runin $-                    K.foldStreamShared-                        undefined-                        yieldk-                        single-                        incrContinue-                        m-            res <- restoreM r-            case res of-                Continue -> run-                Suspend -> liftIO $ stop sv winfo-        -- Avoid any side effects, undo the yield limit decrement if we-        -- never yielded anything.-        else liftIO $ do-            enqueueLIFO sv qref inner item-            incrementYieldLimit (remainingWork sv)-            stop sv winfo--        where--        single a = do-            res <- liftIO $ yield sv winfo a-            return $ if res then Continue else Suspend--        -- XXX can we pass on the yield limit downstream to limit the-        -- concurrency of constituent streams.-        yieldk a r = do-            res <- liftIO $ yield sv winfo a-            yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-            if res && yieldLimitOk-            then K.foldStreamShared undefined yieldk single incrContinue r-            else do-                runInIO <- askRunInIO-                liftIO $ incrementYieldLimit (remainingWork sv)-                liftIO $ enqueueLIFO sv qref inner (runInIO, r)-                return Suspend------------------------------------------------------------------------------------ Ahead Channel Data Structures------------------------------------------------------------------------------------ XXX Left associated ahead expressions are expensive. We start a new SVar for--- each left associative expression. The queue is used only for right--- associated expression, we queue the right expression and execute the left.--- Therefore the queue never has more than one item in it. However, in case of--- parIterateConcatMap the iteration may add more items at the end of the--- queue.------ XXX we can fix this. When we queue more than one item on the queue we can--- mark the previously queued item as not-runnable. The not-runnable item is--- not dequeued until the already running one has finished and at that time we--- would also know the exact sequence number of the already queued item.------ we can even run the already queued items but they will have to be sorted in--- layers in the heap. We can use a list of heaps for that.-{-# ANN enqueueAhead "HLint: ignore" #-}-{-# INLINE enqueueAhead #-}-enqueueAhead ::-       Channel m a-    -> IORef ([K.StreamK m a], Int)-    -> (RunInIO m, K.StreamK m a)-    -> IO ()-enqueueAhead sv q m = do-    -- XXX The queue is LIFO. When parConcatIterate queues more than one items-    -- to the queue it will perform a DFS style traversal. For BFS we will have-    -- to use a FIFO data structure here. That would require another Config-    -- option.-    atomicModifyIORefCAS_ q $ \(xs, n) -> (snd m:xs, n)-    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)---- Normally the thread that has the token should never go away. The token gets--- handed over to another thread, but someone or the other has the token at any--- point of time. But if the task that has the token finds that the outputQueue--- is full, in that case it can go away without even handing over the token to--- another thread. In that case it sets the nextSequence number in the heap its--- own sequence number before going away. To handle this case, any task that--- does not have the token tries to dequeue from the heap first before--- dequeuing from the work queue. If it finds that the task at the top of the--- heap is the one that owns the current sequence number then it grabs the--- token and starts with that.------ XXX instead of queueing just the head element and the remaining computation--- on the heap, evaluate as many as we can and place them on the heap. But we--- need to give higher priority to the lower sequence numbers so that lower--- priority tasks do not fill up the heap making higher priority tasks block--- due to full heap. Maybe we can have a weighted space for them in the heap.--- The weight is inversely proportional to the sequence number.------ XXX review for livelock--{-# INLINE dequeueAhead #-}-dequeueAhead :: MonadIO m-    => IORef ([t m a], Int) -> m (Maybe (t m a, Int))-dequeueAhead q = liftIO $-    atomicModifyIORefCAS q $ \case-            ([], n) -> (([], n), Nothing)-            (x : xs, n) -> ((xs, n + 1), Just (x, n + 1))---- Dequeue only if the seq number matches the expected seq number.-{-# INLINE dequeueAheadSeqCheck #-}-dequeueAheadSeqCheck :: MonadIO m-    => IORef ([t m a], Int) -> Int -> m (Maybe (t m a))-dequeueAheadSeqCheck q seqNo = liftIO $-    atomicModifyIORefCAS q $ \case-            ([], n) -> (([], n), Nothing)-            (x : xs, n) ->-                if n + 1 == seqNo-                then ((xs, n + 1), Just x)-                else ((x : xs, n), Nothing)------------------------------------------------------------------------------------ Heap manipulation----------------------------------------------------------------------------------withIORef :: IORef a -> (a -> IO b) -> IO b-withIORef ref f = readIORef ref >>= f--atomicModifyIORef_ :: IORef a -> (a -> a) -> IO ()-atomicModifyIORef_ ref f =-    atomicModifyIORef ref $ \x -> (f x, ())--data AheadHeapEntry (t :: (Type -> Type) -> Type -> Type) m a =-      AheadEntryNull-    | AheadEntryPure a-    | AheadEntryStream (RunInIO m, t m a)--data HeapDequeueResult t m a =-      Clearing-    | Waiting Int-    | Ready (Entry Int (AheadHeapEntry t m a))--{-# INLINE dequeueFromHeap #-}-dequeueFromHeap-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> IO (HeapDequeueResult t m a)-dequeueFromHeap hpVar =-    atomicModifyIORef hpVar $ \pair@(hp, snum) ->-        case snum of-            Nothing -> (pair, Clearing)-            Just n -> do-                let r = H.uncons hp-                case r of-                    Just (ent@(Entry seqNo _ev), hp') ->-                            if seqNo == n-                            then ((hp', Nothing), Ready ent)-                            else assert (seqNo >= n) (pair, Waiting n)-                    Nothing -> (pair, Waiting n)--{-# INLINE dequeueFromHeapSeq #-}-dequeueFromHeapSeq-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> Int-    -> IO (HeapDequeueResult t m a)-dequeueFromHeapSeq hpVar i =-    atomicModifyIORef hpVar $ \(hp, snum) ->-        case snum of-            Nothing -> do-                let r = H.uncons hp-                case r of-                    Just (ent@(Entry seqNo _ev), hp') ->-                        if seqNo == i-                        then ((hp', Nothing), Ready ent)-                        else assert (seqNo >= i) ((hp, Just i), Waiting i)-                    Nothing -> ((hp, Just i), Waiting i)-            Just _ -> error "dequeueFromHeapSeq: unreachable"--heapIsSane :: Maybe Int -> Int -> Bool-heapIsSane snum seqNo =-    case snum of-        Nothing -> True-        Just n -> seqNo >= n--{-# INLINE requeueOnHeapTop #-}-requeueOnHeapTop-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> Entry Int (AheadHeapEntry t m a)-    -> Int-    -> IO ()-requeueOnHeapTop hpVar ent seqNo =-    atomicModifyIORef_ hpVar $ \(hp, snum) ->-        assert (heapIsSane snum seqNo) (H.insert ent hp, Just seqNo)--{-# INLINE updateHeapSeq #-}-updateHeapSeq-    :: IORef (Heap (Entry Int (AheadHeapEntry t m a)), Maybe Int)-    -> Int-    -> IO ()-updateHeapSeq hpVar seqNo =-    atomicModifyIORef_ hpVar $ \(hp, snum) ->-        assert (heapIsSane snum seqNo) (hp, Just seqNo)----------------------------------------------------------------------------------- Ahead: Concurrent streams with ordered results----------------------------------------------------------------------------------- Lookahead streams can execute multiple tasks concurrently, ahead of time,--- but always serve them in the same order as they appear in the stream. To--- implement lookahead streams efficiently we assign a sequence number to each--- task when the task is picked up for execution. When the task finishes, the--- output is tagged with the same sequence number and we rearrange the outputs--- in sequence based on that number.------ To explain the mechanism imagine that the current task at the head of the--- stream has a "token" to yield to the outputQueue. The ownership of the token--- is determined by the current sequence number is maintained in outputHeap.--- Sequence number is assigned when a task is queued. When a thread dequeues a--- task it picks up the sequence number as well and when the output is ready it--- uses the sequence number to queue the output to the outputQueue.------ The thread with current sequence number sends the output directly to the--- outputQueue. Other threads push the output to the outputHeap. When the task--- being queued on the heap is a stream of many elements we evaluate only the--- first element and keep the rest of the unevaluated computation in the heap.--- When such a task gets the "token" for outputQueue it evaluates and directly--- yields all the elements to the outputQueue without checking for the--- "token".------ Note that no two outputs in the heap can have the same sequence numbers and--- therefore we do not need a stable heap. We have also separated the buffer--- for the current task (outputQueue) and the pending tasks (outputHeap) so--- that the pending tasks cannot interfere with the current task. Note that for--- a single task just the outputQueue is enough and for the case of many--- threads just a heap is good enough. However we balance between these two--- cases, so that both are efficient.------ For bigger streams it may make sense to have separate buffers for each--- stream. However, for singleton streams this may become inefficient. However,--- if we do not have separate buffers, then the streams that come later in--- sequence may hog the buffer, hindering the streams that are ahead. For this--- reason we have a single element buffer limitation for the streams being--- executed in advance.------ This scheme works pretty efficiently with less than 40% extra overhead--- compared to the Async streams where we do not have any kind of sequencing of--- the outputs. It is especially devised so that we are most efficient when we--- have short tasks and need just a single thread. Also when a thread yields--- many items it can hold lockfree access to the outputQueue and do it--- efficiently.------ XXX Maybe we can start the ahead threads at a lower cpu and IO priority so--- that they do not hog the resources and hinder the progress of the threads in--- front of them.---- Left associated ahead expressions are expensive. We start a new SVar for--- each left associative expression. The queue is used only for right--- associated expression, we queue the right expression and execute the left.--- Thererefore the queue never has more than on item in it.------ XXX Also note that limiting concurrency for cases like "take 10" would not--- work well with left associative expressions, because we have no visibility--- about how much the left side of the expression would yield.------ XXX It may be a good idea to increment sequence numbers for each yield,--- currently a stream on the left side of the expression may yield many--- elements with the same sequene number. We can then use the seq number to--- enforce yieldMax and yieldLImit as well.---- Invariants:------ * A worker should always ensure that it pushes all the consecutive items in--- the heap to the outputQueue especially the items on behalf of the workers--- that have already left when we were holding the token. This avoids deadlock--- conditions when the later workers completion depends on the consumption of--- earlier results. For more details see comments in the consumer pull side--- code.--{-# INLINE underMaxHeap #-}-underMaxHeap ::-       Channel m a-    -> Heap (Entry Int (AheadHeapEntry K.StreamK m a))-    -> IO Bool-underMaxHeap sv hp = do-    (_, len) <- readIORef (outputQueue sv)--    -- XXX simplify this-    let maxHeap = case maxBufferLimit sv of-            Limited lim -> Limited $-                max 0 (lim - fromIntegral len)-            Unlimited -> Unlimited--    case maxHeap of-        Limited lim -> do-            active <- readIORef (workerCount sv)-            return $ H.size hp + active <= fromIntegral lim-        Unlimited -> return True---- Return value:--- True => stop--- False => continue-preStopCheck ::-       Channel m a-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)) , Maybe Int)-    -> IO Bool-preStopCheck sv heap =-    -- check the stop condition under a lock before actually-    -- stopping so that the whole herd does not stop at once.-    withIORef heap $ \(hp, _) -> do-        heapOk <- underMaxHeap sv hp-        takeMVar (workerStopMVar sv)-        let stopping = do-                putMVar (workerStopMVar sv) ()-                return True-            continue = do-                putMVar (workerStopMVar sv) ()-                return False-        if heapOk-        then-            case yieldRateInfo sv of-                Nothing -> continue-                Just yinfo -> do-                    rateOk <--                        isBeyondMaxRate-                            (maxWorkerLimit sv) (workerCount sv) yinfo-                    if rateOk then continue else stopping-        else stopping--abortExecution :: Channel m a -> Maybe WorkerInfo -> IO ()-abortExecution sv winfo = do-    incrementYieldLimit (remainingWork sv)-    stop sv winfo---- XXX In absence of a "noyield" primitive (i.e. do not pre-empt inside a--- critical section) from GHC RTS, we have a difficult problem. Assume we have--- a 100,000 threads producing output and queuing it to the heap for--- sequencing. The heap can be drained only by one thread at a time, any thread--- that finds that heap can be drained now, takes a lock and starts draining--- it, however the thread may get prempted in the middle of it holding the--- lock. Since that thread is holding the lock, the other threads cannot pick--- up the draining task, therefore they proceed to picking up the next task to--- execute. If the draining thread could yield voluntarily at a point where it--- has released the lock, then the next threads could pick up the draining--- instead of executing more tasks. When there are 100,000 threads the drainer--- gets a cpu share to run only 1:100000 of the time. This makes the heap--- accumulate a lot of output when we the buffer size is large.------ The solutions to this problem are:--- 1) make the other threads wait in a queue until the draining finishes--- 2) make the other threads queue and go away if draining is in progress------ In both cases we give the drainer a chance to run more often.----processHeap-    :: MonadRunInIO m-    => IORef ([K.StreamK m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)), Maybe Int)-    -> Channel m a-    -> Maybe WorkerInfo-    -> AheadHeapEntry K.StreamK m a-    -> Int-    -> Bool -- we are draining the heap before we stop-    -> m ()-processHeap q heap sv winfo entry sno stopping = loopHeap sno entry--    where--    stopIfNeeded ent seqNo r = do-        stopIt <- liftIO $ preStopCheck sv heap-        if stopIt-        then liftIO $ do-            -- put the entry back in the heap and stop-            requeueOnHeapTop heap (Entry seqNo ent) seqNo-            stop sv winfo-        else runStreamWithYieldLimit True seqNo r--    loopHeap seqNo ent =-        case ent of-            AheadEntryNull -> nextHeap seqNo-            AheadEntryPure a -> do-                -- Use 'send' directly so that we do not account this in worker-                -- latency as this will not be the real latency.-                -- Don't stop the worker in this case as we are just-                -- transferring available results from heap to outputQueue.-                void-                    $ liftIO-                    $ sendWithDoorBell-                        (outputQueue sv) (outputDoorBell sv) (ChildYield a)-                nextHeap seqNo-            AheadEntryStream (RunInIO runin, r) -> do-                if stopping-                then stopIfNeeded ent seqNo r-                else do-                    res <- liftIO $ runin (runStreamWithYieldLimit True seqNo r)-                    restoreM res--    nextHeap prevSeqNo = do-        res <- liftIO $ dequeueFromHeapSeq heap (prevSeqNo + 1)-        case res of-            Ready (Entry seqNo hent) -> loopHeap seqNo hent-            Clearing -> liftIO $ stop sv winfo-            Waiting _ ->-                if stopping-                then do-                    r <- liftIO $ preStopCheck sv heap-                    if r-                    then liftIO $ stop sv winfo-                    else processWorkQueue prevSeqNo-                else inline processWorkQueue prevSeqNo--    processWorkQueue prevSeqNo = do-        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-        if yieldLimitOk-        then do-            work <- dequeueAhead q-            case work of-                Nothing -> liftIO $ stop sv winfo-                Just (m, seqNo) -> do-                    if seqNo == prevSeqNo + 1-                    then processWithToken q heap sv winfo m seqNo-                    else processWithoutToken q heap sv winfo m seqNo-        else liftIO $ abortExecution sv winfo--    -- We do not stop the worker on buffer full here as we want to proceed to-    -- nextHeap anyway so that we can clear any subsequent entries. We stop-    -- only in yield continuation where we may have a remaining stream to be-    -- pushed on the heap.-    singleStreamFromHeap seqNo a = do-        void $ liftIO $ yield sv winfo a-        nextHeap seqNo--    -- XXX when we have an unfinished stream on the heap we cannot account all-    -- the yields of that stream until it finishes, so if we have picked up-    -- and executed more actions beyond that in the parent stream and put them-    -- on the heap then they would eat up some yield limit which is not-    -- correct, we will think that our yield limit is over even though we have-    -- to yield items from unfinished stream before them. For this reason, if-    -- there are pending items in the heap we drain them unconditionally-    -- without considering the yield limit.-    runStreamWithYieldLimit continue seqNo r = do-        _ <- liftIO $ decrementYieldLimit (remainingWork sv)-        if continue -- see comment above -- && yieldLimitOk-        then do-            let stopk = do-                  liftIO (incrementYieldLimit (remainingWork sv))-                  nextHeap seqNo-            K.foldStreamShared undefined-                          (yieldStreamFromHeap seqNo)-                          (singleStreamFromHeap seqNo)-                          stopk-                          r-        else do-            runIn <- askRunInIO-            let ent = Entry seqNo (AheadEntryStream (runIn, r))-            liftIO $ do-                requeueOnHeapTop heap ent seqNo-                incrementYieldLimit (remainingWork sv)-                stop sv winfo--    yieldStreamFromHeap seqNo a r = do-        continue <- liftIO $ yield sv winfo a-        runStreamWithYieldLimit continue seqNo r--{-# NOINLINE drainHeap #-}-drainHeap-    :: MonadRunInIO m-    => IORef ([K.StreamK m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)), Maybe Int)-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-drainHeap q heap sv winfo = do-    r <- liftIO $ dequeueFromHeap heap-    case r of-        Ready (Entry seqNo hent) ->-            processHeap q heap sv winfo hent seqNo True-        _ -> liftIO $ stop sv winfo--data HeapStatus = HContinue | HStop--processWithoutToken-    :: MonadRunInIO m-    => IORef ([K.StreamK m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)), Maybe Int)-    -> Channel m a-    -> Maybe WorkerInfo-    -> K.StreamK m a-    -> Int-    -> m ()-processWithoutToken q heap sv winfo m seqNo = do-    -- we have already decremented the yield limit for m-    let stopk = do-            liftIO (incrementYieldLimit (remainingWork sv))-            -- If the stream stops without yielding anything, and we do not put-            -- anything on heap, but if heap was waiting for this seq number-            -- then it will keep waiting forever, because we are never going to-            -- put it on heap. So we have to put a null entry on heap even when-            -- we stop.-            toHeap AheadEntryNull-        mrun = runInIO $ svarMrun sv--    r <- liftIO $ mrun $-            K.foldStreamShared undefined-                (\a r -> do-                    runIn <- askRunInIO-                    toHeap $ AheadEntryStream (runIn, K.cons a r))-                (toHeap . AheadEntryPure)-                stopk-                m-    res <- restoreM r-    case res of-        Continue -> workLoopAhead q heap sv winfo-        Suspend -> drainHeap q heap sv winfo--    where--    -- XXX to reduce contention each CPU can have its own heap-    toHeap ent = do-        -- Heap insertion is an expensive affair so we use a non CAS based-        -- modification, otherwise contention and retries can make a thread-        -- context switch and throw it behind other threads which come later in-        -- sequence.-        newHp <- liftIO $ atomicModifyIORef heap $ \(hp, snum) ->-            let hp' = H.insert (Entry seqNo ent) hp-            in assert (heapIsSane snum seqNo) ((hp', snum), hp')--        when (svarInspectMode sv) $-            liftIO $ do-                maxHp <- readIORef (maxHeapSize $ svarStats sv)-                when (H.size newHp > maxHp) $-                    writeIORef (maxHeapSize $ svarStats sv) (H.size newHp)--        heapOk <- liftIO $ underMaxHeap sv newHp-        status <--            case yieldRateInfo sv of-                Nothing -> return HContinue-                Just yinfo ->-                    case winfo of-                        Just info -> do-                            rateOk <--                                liftIO-                                    $ workerRateControl-                                        (maxWorkerLimit sv)-                                        (workerCount sv)-                                        yinfo-                                        info-                            if rateOk-                            then return HContinue-                            else return HStop-                        Nothing -> return HContinue--        if heapOk-        then-            case status of-                HContinue -> return Continue-                HStop -> return Suspend-        else return Suspend--data TokenWorkerStatus = TokenContinue Int | TokenSuspend--processWithToken-    :: MonadRunInIO m-    => IORef ([K.StreamK m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)), Maybe Int)-    -> Channel m a-    -> Maybe WorkerInfo-    -> K.StreamK m a-    -> Int-    -> m ()-processWithToken q heap sv winfo action sno = do-    -- Note, we enter this function with yield limit already decremented-    -- XXX deduplicate stop in all invocations-    let stopk = do-            liftIO (incrementYieldLimit (remainingWork sv))-            return $ TokenContinue (sno + 1)-        mrun = runInIO $ svarMrun sv--    r <--        liftIO-            $ mrun-            $ K.foldStreamShared-                undefined (yieldOutput sno) (singleOutput sno) stopk action--    res <- restoreM r-    case res of-        TokenContinue seqNo -> loopWithToken seqNo-        TokenSuspend -> drainHeap q heap sv winfo--    where--    singleOutput seqNo a = do-        continue <- liftIO $ yield sv winfo a-        if continue-        then return $ TokenContinue (seqNo + 1)-        else do-            liftIO $ updateHeapSeq heap (seqNo + 1)-            return TokenSuspend--    -- XXX use a wrapper function around stop so that we never miss-    -- incrementing the yield in a stop continuation. Essentiatlly all-    -- "unstream" calls in this function must increment yield limit on stop.-    yieldOutput seqNo a r = do-        continue <- liftIO $ yield sv winfo a-        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-        if continue && yieldLimitOk-        then do-            let stopk = do-                    liftIO (incrementYieldLimit (remainingWork sv))-                    return $ TokenContinue (seqNo + 1)-            K.foldStreamShared undefined-                          (yieldOutput seqNo)-                          (singleOutput seqNo)-                          stopk-                          r-        else do-            runIn <- askRunInIO-            let ent = Entry seqNo (AheadEntryStream (runIn, r))-            liftIO $ requeueOnHeapTop heap ent seqNo-            liftIO $ incrementYieldLimit (remainingWork sv)-            return TokenSuspend--    loopWithToken nextSeqNo = do-        let preExit = liftIO $ do-                updateHeapSeq heap nextSeqNo-                incrementYieldLimit (remainingWork sv)-        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-        -- To avoid a race when another thread puts something-        -- on the heap and goes away, the consumer will not get-        -- a doorBell and we will not clear the heap before-        -- executing the next action. If the consumer depends-        -- on the output that is stuck in the heap then this-        -- will result in a deadlock. So we always clear the-        -- heap before executing the next action.-        if yieldLimitOk-        then do-            -- XXX Instead of checking seqno inside dequeue we can dequeue-            -- unconditionally and if the seqNo is not the same as nextSeqNo-            -- then release the token and call processWithoutToken. Need-            -- to check the performance though.-            work <- dequeueAheadSeqCheck q nextSeqNo-            case work of-                Nothing -> preExit >> workLoopAhead q heap sv winfo-                Just m -> do-                    let stopk = do-                            liftIO (incrementYieldLimit (remainingWork sv))-                            return $ TokenContinue (nextSeqNo + 1)-                        mrun = runInIO $ svarMrun sv-                    r <- liftIO $ mrun $-                        K.foldStreamShared undefined-                                      (yieldOutput nextSeqNo)-                                      (singleOutput nextSeqNo)-                                      stopk-                                      m-                    res <- restoreM r-                    case res of-                        TokenContinue seqNo -> loopWithToken seqNo-                        TokenSuspend -> drainHeap q heap sv winfo-        else preExit >> drainHeap q heap sv winfo---- XXX the yield limit changes increased the performance overhead by 30-40%.--- Just like AsyncT we can use an implementation without yeidlimit and even--- without pacing code to keep the performance higher in the unlimited and--- unpaced case.------ XXX The yieldLimit stuff is pretty invasive. We can instead do it by using--- three hooks, a pre-execute hook, a yield hook and a stop hook. In fact these--- hooks can be used for a more general implementation to even check predicates--- and not just yield limit.--workLoopAhead-    :: MonadRunInIO m-    => IORef ([K.StreamK m a], Int)-    -> IORef (Heap (Entry Int (AheadHeapEntry K.StreamK m a)), Maybe Int)-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-workLoopAhead q heap sv winfo = do-        r <- liftIO $ dequeueFromHeap heap-        case r of-            Ready (Entry seqNo hent) ->-                processHeap q heap sv winfo hent seqNo False-            Clearing -> liftIO $ stop sv winfo-            Waiting _ -> do-                -- Before we execute the next item from the work queue we check-                -- if we are beyond the yield limit. It is better to check the-                -- yield limit before we pick up the next item. Otherwise we-                -- may have already started more tasks even though we may have-                -- reached the yield limit.  We can avoid this by taking active-                -- workers into account, but that is not as reliable, because-                -- workers may go away without picking up work and yielding a-                -- value.-                ---                -- Rate control can be done either based on actual yields in-                -- the output queue or based on any yield either to the heap or-                -- to the output queue. In both cases we may have one issue or-                -- the other. We chose to do this based on actual yields to the-                -- output queue because it makes the code common to both async-                -- and ahead streams.-                ---                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-                if yieldLimitOk-                then do-                    work <- dequeueAhead q-                    case work of-                        Nothing -> liftIO $ stop sv winfo-                        Just (m, seqNo) -> do-                            if seqNo == 0-                            then processWithToken q heap sv winfo m seqNo-                            else processWithoutToken q heap sv winfo m seqNo-                else liftIO $ abortExecution sv winfo------------------------------------------------------------------------------------ SVar creation--- This code belongs in SVar.hs but is kept here for perf reasons------------------------------------------------------------------------------------ XXX we have this function in this file because passing runStreamLIFO as a--- function argument to this function results in a perf degradation of more--- than 10%.  Need to investigate what the root cause is.--- Interestingly, the same thing does not make any difference for Ahead.--- {-# INLINABLE getLifoSVar #-}-getLifoSVar :: forall m a. MonadRunInIO m =>-    RunInIO m -> Config -> IO (Channel m a)-getLifoSVar mrun cfg = do-    outQ    <- newIORef ([], 0)-    -- the second component of the tuple is "Nothing" when heap is being-    -- cleared, "Just n" when we are expecting sequence number n to arrive-    -- before we can start clearing the heap.-    outH    <- newIORef (H.empty, Just 0)-    outQMv  <- newEmptyMVar-    active  <- newIORef 0-    wfw     <- newIORef False-    running <- newIORef Set.empty-    q       <- newIORef-                ( [] :: [(RunInIO m, K.StreamK m a)]-                , [] :: [(RunInIO m, K.StreamK m a)]-                )-    -- Sequence number is incremented whenever something is de-queued,-    -- therefore, first sequence number would be 0-    aheadQ <- newIORef ([], -1)-    stopMVar <- newMVar ()-    yl <--        case getYieldLimit cfg of-            Nothing -> return Nothing-            Just x -> Just <$> newIORef x-    rateInfo <- newRateInfo cfg--    stats <- newSVarStats-    tid <- myThreadId--    -- We are reading it without lock, the result would be reliable only if no-    -- worker is pending.-    let isWorkFinished _ = do-            (xs, ys) <- readIORef q-            return (null xs && null ys)--    let isWorkFinishedLimited sv = do-            yieldsDone <--                    case remainingWork sv of-                        Just ref -> do-                            n <- readIORef ref-                            return (n <= 0)-                        Nothing -> return False-            qEmpty <- isWorkFinished sv-            return $ qEmpty || yieldsDone--    let eagerEval = getEagerDispatch cfg-        inOrder = getOrdered cfg--    let getSVar :: Channel m a-            -> (Channel m a -> m [ChildEvent a])-            -> (Channel m a -> m Bool)-            -> (Channel m a -> IO Bool)-            -> (IORef ([(RunInIO m, K.StreamK m a)], [(RunInIO m, K.StreamK m a)])-                -> Channel m a-                -> Maybe WorkerInfo-                -> m())-            -> Channel m a-        getSVar sv readOutput postProc workDone wloop = Channel-            { outputQueue      = outQ-            , remainingWork    = yl-            , maxBufferLimit   = getMaxBuffer cfg-            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)-            , yieldRateInfo    = rateInfo-            , outputDoorBell   = outQMv-            , readOutputQ      = readOutput sv-            , postProcess      = postProc sv-            , workerThreads    = running--            , workLoop =-                if inOrder-                then workLoopAhead aheadQ outH sv-                else wloop q sv-            , enqueue =-                \inner ->-                    if inOrder-                    then enqueueAhead sv aheadQ-                    else enqueueLIFO sv q inner-            , eagerDispatch = when eagerEval $ void $ dispatchWorker 0 sv-            , isWorkDone =-                if inOrder-                then isWorkDoneAhead sv aheadQ outH-                else workDone sv-            , isQueueDone =-                if inOrder-                then isQueueDoneAhead sv aheadQ-                else workDone sv--            , doorBellOnWorkQ  = wfw-            , svarMrun         = mrun-            , workerCount      = active-            -- XXX We can use delThread or modThread based on eager flag.-            , accountThread    = modifyThread running outQMv-            , workerStopMVar   = stopMVar-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode cfg-            , svarCreator      = tid-            , svarStats        = stats-            }--    let sv =-            case getStreamRate cfg of-                Nothing ->-                    case getYieldLimit cfg of-                        Nothing -> getSVar sv (readOutputQBounded eagerEval)-                                              postProcessBounded-                                              isWorkFinished-                                              workLoopLIFO-                        Just _  -> getSVar sv (readOutputQBounded eagerEval)-                                              postProcessBounded-                                              isWorkFinishedLimited-                                              workLoopLIFOLimited-                Just _  ->-                    case getYieldLimit cfg of-                        Nothing -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinished-                                              workLoopLIFO-                        Just _  -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinishedLimited-                                              workLoopLIFOLimited-     in return sv--    where--    {-# INLINE isQueueDoneAhead #-}-    isQueueDoneAhead sv q = do-        queueDone <- checkEmpty q-        yieldsDone <--                case remainingWork sv of-                    Just yref -> do-                        n <- readIORef yref-                        return (n <= 0)-                    Nothing -> return False-        -- XXX note that yieldsDone can only be authoritative only when there-        -- are no workers running. If there are active workers they can-        -- later increment the yield count and therefore change the result.-        return $ yieldsDone || queueDone--    {-# INLINE isWorkDoneAhead #-}-    isWorkDoneAhead sv q ref = do-        heapDone <- do-                (hp, _) <- readIORef ref-                return (H.size hp <= 0)-        queueDone <- isQueueDoneAhead sv q-        return $ heapDone && queueDone--    checkEmpty q = do-        (xs, _) <- readIORef q-        return $ null xs---- | Create a new async style concurrent stream evaluation channel. The monad--- state used to run the stream actions is taken from the call site of--- newAppendChannel.-{-# INLINABLE newAppendChannel #-}-{-# SPECIALIZE newAppendChannel :: (Config -> Config) -> IO (Channel IO a) #-}-newAppendChannel :: MonadRunInIO m => (Config -> Config) -> m (Channel m a)-newAppendChannel modifier = do-    mrun <- askRunInIO-    liftIO $ getLifoSVar mrun (modifier defaultConfig)
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Consumer.hs 
@@ -1,127 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer-    (-    -- * Read Output-      readOutputQPaced-    , readOutputQBounded--    -- * Postprocess Hook After Reading-    , postProcessPaced-    , postProcessBounded-    )-where--import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.IORef (readIORef)-import Streamly.Internal.Control.Concurrent (MonadRunInIO)--import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Dispatcher-import Streamly.Internal.Data.Channel.Types------------------------------------------------------------------------------------ Reading from the workers' output queue/buffer----------------------------------------------------------------------------------{-# INLINE readOutputQChan #-}-readOutputQChan :: Channel m a -> IO ([ChildEvent a], Int)-readOutputQChan sv = do-    let ss = if svarInspectMode sv then Just (svarStats sv) else Nothing-     in readOutputQRaw (outputQueue sv) ss--readOutputQBounded :: MonadRunInIO m => Bool -> Channel m a -> m [ChildEvent a]-readOutputQBounded eagerEval sv = do-    (list, len) <- liftIO $ readOutputQChan sv-    -- When there is no output seen we dispatch more workers to help-    -- out if there is work pending in the work queue.-    if len <= 0-    then blockingRead-    else do-        -- send a worker proactively, if needed, even before we start-        -- processing the output.  This may degrade single processor-        -- perf but improves multi-processor, because of more-        -- parallelism-        sendOneWorker-        return list--    where--    sendOneWorker = do-        cnt <- liftIO $ readIORef $ workerCount sv-        when (cnt <= 0) $ do-            done <- liftIO $ isWorkDone sv-            when (not done) (pushWorker 0 sv)--    {-# INLINE blockingRead #-}-    blockingRead = do-        sendWorkerWait eagerEval sendWorkerDelay (dispatchWorker 0) sv-        liftIO (fst `fmap` readOutputQChan sv)--readOutputQPaced :: MonadRunInIO m => Channel m a -> m [ChildEvent a]-readOutputQPaced sv = do-    (list, len) <- liftIO $ readOutputQChan sv-    if len <= 0-    then blockingRead-    else do-        -- XXX send a worker proactively, if needed, even before we start-        -- processing the output.-        void $ dispatchWorkerPaced sv-        return list--    where--    {-# INLINE blockingRead #-}-    blockingRead = do-        sendWorkerWait False sendWorkerDelayPaced dispatchWorkerPaced sv-        liftIO (fst `fmap` readOutputQChan sv)--postProcessPaced :: MonadRunInIO m => Channel m a -> m Bool-postProcessPaced sv = do-    workersDone <- allThreadsDone (workerThreads sv)-    -- XXX If during consumption we figure out we are getting delayed then we-    -- should trigger dispatch there as well.  We should try to check on the-    -- workers after consuming every n item from the buffer?-    if workersDone-    then do-        r <- liftIO $ isWorkDone sv-        when (not r) $ do-            void $ dispatchWorkerPaced sv-            -- Note that we need to guarantee a worker since the work is not-            -- finished, therefore we cannot just rely on dispatchWorkerPaced-            -- which may or may not send a worker.-            noWorker <- allThreadsDone (workerThreads  sv)-            when noWorker $ pushWorker 0 sv-        return r-    else return False--postProcessBounded :: MonadRunInIO m => Channel m a -> m Bool-postProcessBounded sv = do-    workersDone <- allThreadsDone (workerThreads sv)-    -- There may still be work pending even if there are no workers pending-    -- because all the workers may return if the outputQueue becomes full. In-    -- that case send off a worker to kickstart the work again.-    ---    -- Note that isWorkDone can only be safely checked if all workers are done.-    -- When some workers are in progress they may have decremented the yield-    -- Limit and later ending up incrementing it again. If we look at the yield-    -- limit in that window we may falsely say that it is 0 and therefore we-    -- are done.-    if workersDone-    then do-        r <- liftIO $ isWorkDone sv-        -- Note that we need to guarantee a worker, therefore we cannot just-        -- use dispatchWorker which may or may not send a worker.-        when (not r) (pushWorker 0 sv)-        -- XXX do we need to dispatch many here?-        -- void $ dispatchWorker sv-        return r-    else return False
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Dispatcher.hs 
@@ -1,417 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC-------module Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-    (-    -- * Dispatching-      pushWorker-    , dispatchWorker-    , dispatchWorkerPaced-    , sendWorkerWait-    , startChannel-    , sendWorkerDelay-    , sendWorkerDelayPaced-    )-where--import Control.Concurrent (takeMVar, threadDelay)-import Control.Exception (assert)-import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.Maybe (fromJust, fromMaybe)-import Data.IORef (modifyIORef, newIORef, readIORef, writeIORef)-import Streamly.Internal.Control.Concurrent (MonadRunInIO)-import Streamly.Internal.Control.ForkLifted (doFork)-import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_, storeLoadBarrier)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)-import Streamly.Internal.Data.Time.Units-       (MicroSecond64(..), diffAbsTime64, fromRelTime64, toRelTime64)--import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Dispatcher-import Streamly.Internal.Data.Channel.Types-import Streamly.Internal.Data.Channel.Worker------------------------------------------------------------------------------------ Dispatching workers----------------------------------------------------------------------------------{-# NOINLINE pushWorker #-}-pushWorker :: MonadRunInIO m => Count -> Channel m a -> m ()-pushWorker yieldMax sv = do-    liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1-    when (svarInspectMode sv)-        $ recordMaxWorkers (workerCount sv) (svarStats sv)-    -- This allocation matters when significant number of workers are being-    -- sent. We allocate it only when needed.-    winfo <--        case yieldRateInfo sv of-            Nothing -> return Nothing-            Just _ -> liftIO $ do-                cntRef <- newIORef 0-                t <- getTime Monotonic-                lat <- newIORef (0, t)-                return $ Just WorkerInfo-                    { workerYieldMax = yieldMax-                    , workerYieldCount = cntRef-                    , workerLatencyStart = lat-                    }-    -- In case of lazy dispatch we dispatch workers only from the consumer-    -- thread. In that case it is ok to use addThread here as it is guaranteed-    -- that the thread will be added to the workerSet before the thread STOP-    -- event is processed, because we do both of these actions in the same-    -- consumer thread. However, in case of eager dispatch we may dispatch-    -- workers from workers, in which case the thread Stop even may get-    -- processed before the addThread occurs, so in that case we have to use-    -- modifyThread which performs a toggle rather than adding or deleting.-    ---    -- XXX We can use addThread or modThread based on eager flag.-    doFork (workLoop sv winfo) (svarMrun sv) exception >>= modThread--    where--    modThread = modifyThread (workerThreads sv) (outputDoorBell sv)-    exception = handleChildException (outputQueue sv) (outputDoorBell sv)---- | Determine the maximum number of workers required based on 'maxWorkerLimit'--- and 'remainingWork'.-{-# INLINE getEffectiveWorkerLimit #-}-getEffectiveWorkerLimit :: MonadIO m => Channel m a -> m Limit-getEffectiveWorkerLimit sv = do-    let workerLimit = maxWorkerLimit sv-    case remainingWork sv of-        Nothing -> return workerLimit-        Just ref -> do-            n <- liftIO $ readIORef ref-            case yieldRateInfo sv of-                Just _ -> return workerLimit-                Nothing ->-                    return $-                        case workerLimit of-                            Unlimited -> Limited (fromIntegral n)-                            Limited lim -> Limited $ min lim (fromIntegral n)---- | Determine whether the active threads are more than the max threads we are--- allowed to dispatch.-{-# INLINE checkMaxThreads #-}-checkMaxThreads :: MonadIO m => Int -> Channel m a -> m Bool-checkMaxThreads active sv = do-    -- Note that we may deadlock if the previous workers (tasks in the-    -- stream) wait/depend on the future workers (tasks in the stream)-    -- executing. In that case we should either configure the maxWorker-    -- count to higher or use parallel style instead of ahead or async-    -- style.-    limit <- getEffectiveWorkerLimit sv-    return-        $ case limit of-            Unlimited -> True-            -- Note that the use of remainingWork and workerCount is not-            -- atomic and the counts may even have changed between reading-            -- and using them here, so this is just approximate logic and-            -- we cannot rely on it for correctness. We may actually-            -- dispatch more workers than required.-            Limited lim -> fromIntegral lim > active---- | Determine whether we would exceed max buffer if we dispatch more workers--- based on the current outputQueue size and active workers.-{-# INLINE checkMaxBuffer #-}-checkMaxBuffer :: MonadIO m => Int -> Channel m a -> m Bool-checkMaxBuffer active sv = do-    let limit = maxBufferLimit sv-    case limit of-        Unlimited -> return True-        Limited lim -> do-            (_, n) <- liftIO $ readIORef (outputQueue sv)-            return $ fromIntegral lim > n + active--dispatchWorker :: MonadRunInIO m =>-    Count -> Channel m a -> m Bool-dispatchWorker yieldCount sv = do-    -- XXX in case of Ahead streams we should not send more than one worker-    -- when the work queue is done but heap is not done.-    -- XXX Should we have a single abstraction for checking q and-    -- work instead checking the two separately?-    done <- liftIO $ isWorkDone sv-    -- Note, "done" may not mean that the work is actually finished if there-    -- are workers active, because there may be a worker which has not yet-    -- queued the leftover work.-    if not done-    then do-        qDone <- liftIO $ isQueueDone sv-        -- This count may be more until the sendStop events are processed.-        active <- liftIO $ readIORef $ workerCount sv-        when (active < 0) $ error "dispatchWorker active negative"-        if not qDone-        then do-            -- XXX for ahead streams shall we take the heap yields into account-            -- for controlling the dispatch? We should not dispatch if the heap-            -- has already got the limit covered.-            r <- checkMaxThreads active sv-            if r-            then do-                r1 <- checkMaxBuffer active sv-                if r1-                then pushWorker yieldCount sv >> return True-                else return False-            else return False-        else do-            when (active <= 0) $ do-                r <- liftIO $ isWorkDone sv-                when (not r) $ pushWorker 0 sv-            return False-    else return False---- XXX in case of ahead style stream we need to take the heap size into account--- because we return the workers on the basis of that which causes a condition--- where we keep dispatching and they keep returning. So we must have exactly--- the same logic for not dispatching and for returning.------ Returns:--- True: can dispatch more--- False: full, no more dispatches-dispatchWorkerPaced :: MonadRunInIO m =>-    Channel m a -> m Bool-dispatchWorkerPaced sv = do-    let yinfo = fromJust $ yieldRateInfo sv-    (svarYields, svarElapsed, wLatency) <- do-        now <- liftIO $ getTime Monotonic-        (yieldCount, baseTime, lat) <--            liftIO-                $ collectLatency-                    (svarInspectMode sv) (svarStats sv) yinfo False-        let elapsed = fromRelTime64 $ diffAbsTime64 now baseTime-        let latency =-                if lat == 0-                then fromMaybe lat (workerBootstrapLatency yinfo)-                else lat--        return (yieldCount, elapsed, latency)--    if wLatency == 0-    -- Need to measure the latency with a single worker before we can perform-    -- any computation.-    then return False-    else do-        let workerLimit = maxWorkerLimit sv-        let targetLat = svarLatencyTarget yinfo-        let range = svarLatencyRange yinfo-        gainLoss <- liftIO $ readIORef (svarGainedLostYields yinfo)-        let work = estimateWorkers workerLimit svarYields gainLoss svarElapsed-                                   wLatency targetLat range--        -- XXX we need to take yieldLimit into account here. If we are at the-        -- end of the limit as well as the time, we should not be sleeping.-        -- If we are not actually planning to dispatch any more workers we need-        -- to take that in account.-        case work of-            BlockWait s -> do-                assert (s >= 0) (return ())-                -- XXX note that when we return from here we will block waiting-                -- for the result from the existing worker. If that takes too-                -- long we won't be able to send another worker until the-                -- result arrives.-                ---                -- Sleep only if there are no active workers, otherwise we will-                -- defer the output of those. Note we cannot use workerCount-                -- here as it is not a reliable way to ensure there are-                -- definitely no active workers. When workerCount is 0 we may-                -- still have a Stop event waiting in the outputQueue.-                done <- allThreadsDone (workerThreads sv)-                when done $ void $ do-                    let us = fromRelTime64 (toRelTime64 s) :: MicroSecond64-                    liftIO $ threadDelay (fromIntegral us)-                    dispatchWorker 1 sv-                return False-            PartialWorker yields -> do-                assert (yields > 0) (return ())-                updateGainedLostYields yinfo yields--                done <- allThreadsDone (workerThreads sv)-                when done $ void $ dispatchWorker yields sv-                return False-            ManyWorkers netWorkers yields -> do-                assert (netWorkers >= 1) (return ())-                assert (yields >= 0) (return ())-                updateGainedLostYields yinfo yields--                let periodRef = workerPollingInterval yinfo-                    ycnt = max 1 $ yields `div` fromIntegral netWorkers-                    period = min ycnt (fromIntegral magicMaxBuffer)--                old <- liftIO $ readIORef periodRef-                when (period < old) $-                    liftIO $ writeIORef periodRef period--                cnt <- liftIO $ readIORef $ workerCount sv-                if cnt < netWorkers-                then do-                    let total = netWorkers - cnt-                        batch = max 1 $ fromIntegral $-                                    minThreadDelay `div` targetLat-                    -- XXX stagger the workers over a period?-                    -- XXX cannot sleep, as that would mean we cannot process-                    -- the outputs. need to try a different mechanism to-                    -- stagger.-                    -- when (total > batch) $-                       -- liftIO $ threadDelay $ nanoToMicroSecs minThreadDelay-                    dispatchN (min total batch)-                else return False--    where--    updateGainedLostYields yinfo yields = do-        let buf = fromIntegral $ svarRateBuffer yinfo-        when (yields /= 0 && abs yields > buf) $ do-            let delta =-                   if yields > 0-                   then yields - buf-                   else yields + buf-            liftIO $ modifyIORef (svarGainedLostYields yinfo) (+ delta)--    dispatchN n =-        if n == 0-        then return True-        else do-            r <- dispatchWorker 0 sv-            if r-            then dispatchN (n - 1)-            else return False--{-# NOINLINE sendWorkerWait #-}-sendWorkerWait-    :: MonadIO m-    => Bool-    -> (Channel m a -> IO ())-    -> (Channel m a -> m Bool)-    -> Channel m a-    -> m ()-sendWorkerWait eagerEval delay dispatch sv = go--    where--    go = do--        -- Note that we are guaranteed to have at least one outstanding worker-        -- when we enter this function. So if we sleep we are guaranteed to be-        -- woken up by an outputDoorBell, when the worker exits.--        liftIO $ delay sv-        (_, n) <- liftIO $ readIORef (outputQueue sv)-        when (n <= 0 || eagerEval) $ do-            -- The queue may be empty temporarily if the worker has dequeued-            -- the work item but has not enqueued the remaining part yet. For-            -- the same reason, a worker may come back if it tries to dequeue-            -- and finds the queue empty, even though the whole work has not-            -- finished yet.--            -- If we find that the queue is empty, but it may be empty-            -- temporarily, when we checked it. If that's the case we might-            -- sleep indefinitely unless the active workers produce some-            -- output. We may deadlock specially if the otuput from the active-            -- workers depends on the future workers that we may never send.-            -- So in case the queue was temporarily empty set a flag to inform-            -- the enqueue to send us a doorbell.--            -- Note that this is just a best effort mechanism to avoid a-            -- deadlock. Deadlocks may still happen if for some weird reason-            -- the consuming computation shares an MVar or some other resource-            -- with the producing computation and gets blocked on that resource-            -- and therefore cannot do any pushworker to add more threads to-            -- the producer. In such cases the programmer should use a parallel-            -- style so that all the producers are scheduled immediately and-            -- unconditionally. We can also use a separate monitor thread to-            -- push workers instead of pushing them from the consumer, but then-            -- we are no longer using pull based concurrency rate adaptation.-            ---            -- XXX update this in the tutorial.-            ---            -- Having pending active workers does not mean that we are-            -- guaranteed to be woken up if we sleep. In case of Ahead streams,-            -- there may be queued items in the heap even though the-            -- outputQueue is empty, and we may have active workers which are-            -- deadlocked on those items to be processed by the consumer. We-            -- should either guarantee that any worker, before returning,-            -- clears the heap or we send a worker to clear it. Normally we-            -- always send a worker if no output is seen, but if the thread-            -- limit is reached or we are using pacing then we may not send a-            -- worker. See the concurrentApplication test in the tests, that-            -- test case requires at least one yield from the producer to not-            -- deadlock, if the last workers output is stuck in the heap then-            -- this test fails.  This problem can be extended to n threads when-            -- the consumer may depend on the evaluation of next n items in the-            -- producer stream.--            -- register for the outputDoorBell before we check the queue so-            -- that if we sleep because the queue was empty we are guaranteed-            -- to get a doorbell on the next enqueue.--            liftIO $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv) $ const True-            liftIO storeLoadBarrier-            canDoMore <- dispatch sv--            -- XXX test for the case when we miss sending a worker when the-            -- worker count is more than 1500.-            ---            -- XXX Assert here that if the heap is not empty then there is at-            -- least one outstanding worker. Otherwise we could be sleeping-            -- forever.--            if canDoMore-            then go-            else do-                liftIO-                    $ withDiagMVar-                        (svarInspectMode sv)-                        (dumpSVar sv)-                        "sendWorkerWait: nothing to do"-                    $ takeMVar (outputDoorBell sv)-                (_, len) <- liftIO $ readIORef (outputQueue sv)-                if len <= 0-                then go-                else-                    liftIO-                        $ atomicModifyIORefCAS_ (doorBellOnWorkQ sv)-                        $ const False---- | Start the evaluation of the channel's work queue by kicking off a worker.--- Note: Work queue must not be empty otherwise the worker will exit without--- doing anything.-startChannel :: MonadRunInIO m =>-    Channel m a -> m ()-startChannel chan = do-    case yieldRateInfo chan of-        Nothing -> pushWorker 0 chan-        Just yinfo  ->-            if svarLatencyTarget yinfo == maxBound-            then liftIO $ threadDelay maxBound-            else pushWorker 1 chan--sendWorkerDelayPaced :: Channel m a -> IO ()-sendWorkerDelayPaced _ = return ()--sendWorkerDelay :: Channel m a -> IO ()-sendWorkerDelay _sv =-    -- XXX we need a better way to handle this than hardcoded delays. The-    -- delays may be different for different systems.-    -- If there is a usecase where this is required we can create a combinator-    -- to set it as a config in the state.-    {--  do-    ncpu <- getNumCapabilities-    if ncpu <= 1-    then-        if (svarStyle sv == AheadVar)-        then threadDelay 100-        else threadDelay 25-    else-        if (svarStyle sv == AheadVar)-        then threadDelay 100-        else threadDelay 10-    -}-    return ()
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Interleave.hs 
@@ -1,252 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave-    (-      newInterleaveChannel-    )-where--#include "inline.hs"--import Control.Concurrent (myThreadId)-import Control.Concurrent.MVar (newEmptyMVar)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.Concurrent.Queue.MichaelScott (LinkedQueue, newQ, nullQ, tryPopR, pushL)-import Data.IORef (newIORef, readIORef)-import Streamly.Internal.Control.Concurrent-    (MonadRunInIO, MonadAsync, RunInIO(..), askRunInIO, restoreM)-import Streamly.Internal.Data.Channel.Dispatcher (delThread)--import qualified Data.Set as Set-import qualified Streamly.Internal.Data.StreamK as K--import Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer-import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Types----------------------------------------------------------------------------------- Creating a channel---------------------------------------------------------------------------------data WorkerStatus = Continue | Suspend---- XXX This is not strictly round-robin as the streams that are faster may--- yield more elements than the ones that are slower. Also, when streams--- suspend due to buffer getting full they get added to the queue in a random--- order.--{-# INLINE enqueueFIFO #-}-enqueueFIFO ::-       Channel m a-    -> LinkedQueue (RunInIO m, K.StreamK m a)-    -> (RunInIO m, K.StreamK m a)-    -> IO ()-enqueueFIFO sv q m = do-    pushL q m-    ringDoorBell (doorBellOnWorkQ sv) (outputDoorBell sv)--{-# INLINE workLoopFIFO #-}-workLoopFIFO-    :: MonadRunInIO m-    => LinkedQueue (RunInIO m, K.StreamK m a)-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-workLoopFIFO q sv winfo = run--    where--    run = do-        work <- liftIO $ tryPopR q-        case work of-            Nothing -> liftIO $ stop sv winfo-            Just (RunInIO runin, m) -> do-                r <- liftIO-                        $ runin-                        $ K.foldStreamShared-                            undefined yieldk single (return Continue) m-                res <- restoreM r-                case res of-                    Continue -> run-                    Suspend -> liftIO $ stop sv winfo--    single a = do-        res <- liftIO $ yield sv winfo a-        return $ if res then Continue else Suspend--    -- XXX in general we would like to yield "n" elements from a single stream-    -- before moving on to the next. Single element granularity could be too-    -- expensive in certain cases. Similarly, we can use time limit for-    -- yielding.-    yieldk a r = do-        res <- liftIO $ yield sv winfo a-        runInIO <- askRunInIO-        -- XXX If the queue is empty we do not need to enqueue. We can just-        -- continue evaluating the stream.-        liftIO $ enqueueFIFO sv q (runInIO, r)-        return $ if res then Continue else Suspend--{-# INLINE workLoopFIFOLimited #-}-workLoopFIFOLimited-    :: forall m a. MonadRunInIO m-    => LinkedQueue (RunInIO m, K.StreamK m a)-    -> Channel m a-    -> Maybe WorkerInfo-    -> m ()-workLoopFIFOLimited q sv winfo = run--    where--    incrContinue =-        liftIO (incrementYieldLimit (remainingWork sv)) >> return Continue--    run = do-        work <- liftIO $ tryPopR q-        case work of-            Nothing -> liftIO $ stop sv winfo-            Just (RunInIO runin, m) -> do-                yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-                if yieldLimitOk-                then do-                    r <- liftIO-                            $ runin-                            $ K.foldStreamShared-                                undefined yieldk single incrContinue m-                    res <- restoreM r-                    case res of-                        Continue -> run-                        Suspend -> liftIO $ stop sv winfo-                else liftIO $ do-                    enqueueFIFO sv q (RunInIO runin, m)-                    incrementYieldLimit (remainingWork sv)-                    stop sv winfo--    single a = do-        res <- liftIO $ yield sv winfo a-        return $ if res then Continue else Suspend--    yieldk a r = do-        res <- liftIO $ yield sv winfo a-        runInIO <- askRunInIO-        liftIO $ enqueueFIFO sv q (runInIO, r)-        yieldLimitOk <- liftIO $ decrementYieldLimit (remainingWork sv)-        if res && yieldLimitOk-        then return Continue-        else liftIO $ do-            incrementYieldLimit (remainingWork sv)-            return Suspend------------------------------------------------------------------------------------ SVar creation------------------------------------------------------------------------------------ XXX we have this function in this file because passing runStreamLIFO as a--- function argument to this function results in a perf degradation of more--- than 10%.  Need to investigate what the root cause is.--- Interestingly, the same thing does not make any difference for Ahead.-getFifoSVar :: forall m a. MonadRunInIO m =>-    RunInIO m -> Config -> IO (Channel m a)-getFifoSVar mrun cfg = do-    outQ    <- newIORef ([], 0)-    outQMv  <- newEmptyMVar-    active  <- newIORef 0-    wfw     <- newIORef False-    running <- newIORef Set.empty-    q       <- newQ-    yl      <- case getYieldLimit cfg of-                Nothing -> return Nothing-                Just x -> Just <$> newIORef x-    rateInfo <- newRateInfo cfg--    stats <- newSVarStats-    tid <- myThreadId--    let isWorkFinished _ = nullQ q-    let isWorkFinishedLimited sv = do-            yieldsDone <--                    case remainingWork sv of-                        Just ref -> do-                            n <- readIORef ref-                            return (n <= 0)-                        Nothing -> return False-            qEmpty <- nullQ q-            return $ qEmpty || yieldsDone--    let getSVar :: Channel m a-            -> (Channel m a -> m [ChildEvent a])-            -> (Channel m a -> m Bool)-            -> (Channel m a -> IO Bool)-            -> (LinkedQueue (RunInIO m, K.StreamK m a)-                -> Channel m a-                -> Maybe WorkerInfo-                -> m())-            -> Channel m a-        getSVar sv readOutput postProc workDone wloop = Channel-            { outputQueue      = outQ-            , remainingWork    = yl-            , maxBufferLimit   = getMaxBuffer cfg-            , maxWorkerLimit   = min (getMaxThreads cfg) (getMaxBuffer cfg)-            , yieldRateInfo    = rateInfo-            , outputDoorBell   = outQMv-            , readOutputQ      = readOutput sv-            , postProcess      = postProc sv-            , workerThreads    = running-            , workLoop         = wloop q sv-            , enqueue          = \_ -> enqueueFIFO sv q-            , eagerDispatch    = return ()-            , isWorkDone       = workDone sv-            , isQueueDone      = workDone sv-            , doorBellOnWorkQ  = wfw-            , svarMrun         = mrun-            , workerCount      = active-            , accountThread    = delThread running-            , workerStopMVar   = undefined-            , svarRef          = Nothing-            , svarInspectMode  = getInspectMode cfg-            , svarCreator      = tid-            , svarStats        = stats-            }--    let sv =-            case getStreamRate cfg of-                Nothing ->-                    case getYieldLimit cfg of-                        Nothing -> getSVar sv (readOutputQBounded False)-                                              postProcessBounded-                                              isWorkFinished-                                              workLoopFIFO-                        Just _  -> getSVar sv (readOutputQBounded False)-                                              postProcessBounded-                                              isWorkFinishedLimited-                                              workLoopFIFOLimited-                Just _  ->-                    case getYieldLimit cfg of-                        Nothing -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinished-                                              workLoopFIFO-                        Just _  -> getSVar sv readOutputQPaced-                                              postProcessPaced-                                              isWorkFinishedLimited-                                              workLoopFIFOLimited-     in return sv---- XXX GHC: If instead of MonadAsync we use (MonadIO m, MonadBaseControl IO m)--- constraint we get a 2x perf regression. Need to look into that.------ | Create a new async style concurrent stream evaluation channel. The monad--- state used to run the stream actions is taken from the call site of--- newInterleaveChannel.-{-# INLINABLE newInterleaveChannel #-}-{-# SPECIALIZE newInterleaveChannel :: (Config -> Config) -> IO (Channel IO a) #-}-newInterleaveChannel :: MonadAsync m =>-    (Config -> Config) -> m (Channel m a)-newInterleaveChannel modifier = do-    mrun <- askRunInIO-    liftIO $ getFifoSVar mrun (modifier defaultConfig)
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Operations.hs 
@@ -1,294 +0,0 @@-#ifdef __HADDOCK_VERSION__-#undef INSPECTION-#endif--#ifdef INSPECTION-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-}-#endif---- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Operations--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Concurrent.Channel.Operations-    (-      toChannel-    , toChannelK-    , fromChannel-    , fromChannelK-    )-where--#include "inline.hs"--import Control.Exception (fromException)-import Control.Monad (when)-import Control.Monad.Catch (throwM, MonadThrow)-import Control.Monad.IO.Class (MonadIO(liftIO))-import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef)-import Data.Maybe (isNothing)-import Streamly.Internal.Control.Concurrent-    (MonadAsync, MonadRunInIO, askRunInIO)-import Streamly.Internal.Data.Stream (Stream)-import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)-import System.Mem (performMajorGC)--import qualified Streamly.Internal.Data.Stream as Stream-import qualified Streamly.Internal.Data.Stream as D-import qualified Streamly.Internal.Data.StreamK as K--import Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-import Streamly.Internal.Data.Stream.Concurrent.Channel.Type-import Streamly.Internal.Data.Channel.Types hiding (inspect)--import Prelude hiding (map, concat, concatMap)--#ifdef INSPECTION-import Control.Exception (Exception)-import Control.Monad.Trans.Control (MonadBaseControl)-import Data.Typeable (Typeable)-import Test.Inspection (inspect, hasNoTypeClassesExcept)-#endif----------------------------------------------------------------------------------- Generating streams from a channel----------------------------------------------------------------------------------- $concurrentEval------ Usually a channel is used to concurrently evaluate multiple actions in a--- stream using many worker threads that push the results to the channel and a--- single puller that pulls them from channel generating the evaluated stream.------ @---                  input stream---                       |---     <-----------------|<--------worker---     |  exceptions     |--- output stream <---Channel<------worker---                       |---                       |<--------worker------ @------ The puller itself schedules the worker threads based on demand.--- Exceptions are propagated from the worker threads to the puller.------------------------------------------------------------------------------------ Write a stream to a channel------------------------------------------------------------------------------------ XXX Should be a Fold, singleton API could be called joinChannel, or the fold--- can be called joinChannel.---- | Write a stream to an 'SVar' in a non-blocking manner. The stream can then--- be read back from the SVar using 'fromSVar'.-{-# INLINE toChannelK #-}-toChannelK :: MonadRunInIO m => Channel m a -> K.StreamK m a -> m ()-toChannelK sv m = do-    runIn <- askRunInIO-    liftIO $ enqueue sv False (runIn, m)---- INLINE for fromStreamK/toStreamK fusion---- | Send a stream to a given channel for concurrent evaluation.-{-# INLINE toChannel #-}-toChannel :: MonadRunInIO m => Channel m a -> Stream m a -> m ()-toChannel chan = toChannelK chan . Stream.toStreamK--{---- | Send a stream of streams to a concurrent channel for evaluation.-{-# INLINE joinChannel #-}-joinChannel :: Channel m a -> Fold m (Stream m a) ()-joinChannel = undefined--}------------------------------------------------------------------------------------ Read a stream from a channel------------------------------------------------------------------------------------ | Pull a stream from an SVar.-{-# NOINLINE fromChannelRaw #-}-fromChannelRaw :: (MonadIO m, MonadThrow m) => Channel m a -> K.StreamK m a-fromChannelRaw sv = K.MkStream $ \st yld sng stp -> do-    list <- readOutputQ sv-    -- Reversing the output is important to guarantee that we process the-    -- outputs in the same order as they were generated by the constituent-    -- streams.-    K.foldStream st yld sng stp $ processEvents $ reverse list--    where--    cleanup = do-        when (svarInspectMode sv) $ liftIO $ do-            t <- getTime Monotonic-            writeIORef (svarStopTime (svarStats sv)) (Just t)-            printSVar (dumpSVar sv) "SVar Done"--    {-# INLINE processEvents #-}-    processEvents [] = K.MkStream $ \st yld sng stp -> do-        done <- postProcess sv-        if done-        then cleanup >> stp-        else K.foldStream st yld sng stp $ fromChannelRaw sv--    processEvents (ev : es) = K.MkStream $ \st yld sng stp -> do-        let rest = processEvents es-        case ev of-            ChildYield a -> yld a rest-            ChildStopChannel -> do-                liftIO (cleanupSVar (workerThreads sv))-                cleanup >> stp-            ChildStop tid e -> do-                accountThread sv tid-                case e of-                    Nothing -> K.foldStream st yld sng stp rest-                    Just ex ->-                        case fromException ex of-                            Just ThreadAbort ->-                                -- We terminate the loop after sending-                                -- ThreadAbort to workers so we should never-                                -- get it unless it is thrown from inside a-                                -- worker thread or by someone else to our-                                -- thread.-                                error "processEvents: got ThreadAbort"-                                -- K.foldStream st yld sng stp rest-                            Nothing -> do-                                liftIO (cleanupSVar (workerThreads sv))-                                cleanup >> throwM ex--#ifdef INSPECTION--- Use of GHC constraint tuple (GHC.Classes.(%,,%)) in fromStreamVar leads to--- space leak because the tuple gets allocated in every recursive call and each--- allocation holds on to the previous allocation. This test is to make sure--- that we do not use the constraint tuple type class.----inspect $ hasNoTypeClassesExcept 'fromChannelRaw-    [ ''Monad-    , ''Applicative-    , ''MonadThrow-    , ''Exception-    , ''MonadIO-    , ''MonadBaseControl-    , ''Typeable-    , ''Functor-    ]-#endif---- XXX fromChannel Should not be called multiple times, we can add a--- safeguard for that. Or we can replicate the stream so that we can distribute--- it to multiple consumers. or should we use an explicit dupChannel for that?--{-# INLINE fromChannelK #-}-fromChannelK :: MonadAsync m => Channel m a -> K.StreamK m a-fromChannelK sv =-    K.mkStream $ \st yld sng stp -> do-        ref <- liftIO $ newIORef ()-        _ <- liftIO $ mkWeakIORef ref hook--        startChannel sv-        -- We pass a copy of sv to fromStreamVar, so that we know that it has-        -- no other references, when that copy gets garbage collected "ref"-        -- will get garbage collected and our hook will be called.-        K.foldStreamShared st yld sng stp $-            fromChannelRaw sv{svarRef = Just ref}-    where--    hook = do-        when (svarInspectMode sv) $ do-            r <- liftIO $ readIORef (svarStopTime (svarStats sv))-            when (isNothing r) $-                printSVar (dumpSVar sv) "SVar Garbage Collected"-        cleanupSVar (workerThreads sv)-        -- If there are any SVars referenced by this SVar a GC will prompt-        -- them to be cleaned up quickly.-        when (svarInspectMode sv) performMajorGC---- | Generate a stream of results from concurrent evaluations from a channel.--- Evaluation of the channel does not start until this API is called. This API--- must not be called more than once on a channel. It kicks off evaluation of--- the channel by dispatching concurrent workers and ensures that as long there--- is work queued on the channel workers are dispatched proportional to the--- demand by the consumer.----{-# INLINE fromChannel #-}-fromChannel :: MonadAsync m => Channel m a -> Stream m a-fromChannel = Stream.fromStreamK . fromChannelK--data FromSVarState t m a =-      FromSVarInit-    | FromSVarRead (Channel m a)-    | FromSVarLoop (Channel m a) [ChildEvent a]-    | FromSVarDone (Channel m a)---- | Like 'fromSVar' but generates a StreamD style stream instead of CPS.----{-# INLINE_NORMAL _fromChannelD #-}-_fromChannelD :: (MonadIO m, MonadThrow m) => Channel m a -> D.Stream m a-_fromChannelD svar = D.Stream step FromSVarInit-    where--    {-# INLINE_LATE step #-}-    step _ FromSVarInit = do-        ref <- liftIO $ newIORef ()-        _ <- liftIO $ mkWeakIORef ref hook-        -- when this copy of svar gets garbage collected "ref" will get-        -- garbage collected and our GC hook will be called.-        let sv = svar{svarRef = Just ref}-        return $ D.Skip (FromSVarRead sv)--        where--        {-# NOINLINE hook #-}-        hook = do-            when (svarInspectMode svar) $ do-                r <- liftIO $ readIORef (svarStopTime (svarStats svar))-                when (isNothing r) $-                    printSVar (dumpSVar svar) "SVar Garbage Collected"-            cleanupSVar (workerThreads svar)-            -- If there are any SVars referenced by this SVar a GC will prompt-            -- them to be cleaned up quickly.-            when (svarInspectMode svar) performMajorGC--    step _ (FromSVarRead sv) = do-        list <- readOutputQ sv-        -- Reversing the output is important to guarantee that we process the-        -- outputs in the same order as they were generated by the constituent-        -- streams.-        return $ D.Skip $ FromSVarLoop sv (Prelude.reverse list)--    step _ (FromSVarLoop sv []) = do-        done <- postProcess sv-        return $ D.Skip $ if done-                      then FromSVarDone sv-                      else FromSVarRead sv--    step _ (FromSVarLoop sv (ev : es)) = do-        case ev of-            ChildYield a -> return $ D.Yield a (FromSVarLoop sv es)-            ChildStopChannel -> do-                liftIO (cleanupSVar (workerThreads sv))-                return $ D.Skip (FromSVarDone sv)-            ChildStop tid e -> do-                accountThread sv tid-                case e of-                    Nothing -> return $ D.Skip (FromSVarLoop sv es)-                    Just ex ->-                        case fromException ex of-                            Just ThreadAbort ->-                                return $ D.Skip (FromSVarLoop sv es)-                            Nothing -> do-                                liftIO (cleanupSVar (workerThreads sv))-                                throwM ex--    step _ (FromSVarDone sv) = do-        when (svarInspectMode sv) $ do-            t <- liftIO $ getTime Monotonic-            liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)-            liftIO $ printSVar (dumpSVar sv) "SVar Done"-        return D.Stop
− src/Streamly/Internal/Data/Stream/Concurrent/Channel/Type.hs 
@@ -1,172 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Concurrent.Channel.Type--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Concurrent.Channel.Type-    (-      Channel(..)-    , yield-    , stop-    , stopChannel-    , dumpSVar-    )-where--import Control.Concurrent (ThreadId)-import Control.Concurrent.MVar (MVar)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.IORef (IORef)-import Data.List (intersperse)-import Data.Set (Set)-import Streamly.Internal.Control.Concurrent (RunInIO)-import Streamly.Internal.Data.Atomics (atomicModifyIORefCAS_)-import Streamly.Internal.Data.Channel.Dispatcher (dumpSVarStats)-import Streamly.Internal.Data.Channel.Worker-    (sendYield, sendStop, sendWithDoorBell)-import Streamly.Internal.Data.StreamK (StreamK)--import Streamly.Internal.Data.Channel.Types---- IMPORTANT NOTE: we cannot update the SVar after generating it as we have--- references to the original SVar stored in several functions which will keep--- pointing to the original data and the new updates won't reflect there.--- Any updateable parts must be kept in mutable references (IORef).---- XXX Since we have stream specific channels now, we can remove functions like--- enqueue, readOuputQ, postProcess, workLoop etc from this.---- | A mutable channel to evaluate multiple streams concurrently and provide--- the combined results as output stream.-data Channel m a = Channel-    {-      svarMrun        :: RunInIO m-    -- FORWARD FLOW: Flow of data from the workers to the consumer--    -- Shared output queue (events, length)-    -- XXX For better efficiency we can try a preallocated array type (perhaps-    -- something like a vector) that allows an O(1) append. That way we will-    -- avoid constructing and reversing the list. Possibly we can also avoid-    -- the GC copying overhead. When the size increases we should be able to-    -- allocate the array in chunks.-    ---    -- [LOCKING] Frequent locked access. This is updated by workers on each-    -- yield and once in a while read by the consumer thread. This could have-    -- big locking overhead if the number of workers is high.-    ---    -- XXX We can use a per-CPU data structure to reduce the locking overhead.-    -- However, a per-cpu structure cannot guarantee the exact sequence in-    -- which the elements were added, though that may not be important.-    -- XXX We can send a bundle of events of one type coaleseced together in an-    -- unboxed structure.-    , outputQueue    :: IORef ([ChildEvent a], Int)--    -- [LOCKING] Infrequent MVar. Used when the outputQ transitions from empty-    -- to non-empty, or a work item is queued by a worker to the work queue and-    -- doorBellOnWorkQ is set by the consumer.-    , outputDoorBell :: MVar ()  -- signal the consumer about output-    -- XXX Can we use IO instead of m here?-    , readOutputQ    :: m [ChildEvent a]-    , postProcess    :: m Bool--    -- Scheduling ----    -- Combined/aggregate parameters-    -- This is capped to maxBufferLimit if set to more than that. Otherwise-    -- potentially each worker may yield one value to the buffer in the worst-    -- case exceeding the requested buffer size.-    , maxWorkerLimit :: Limit-    , maxBufferLimit :: Limit--    -- [LOCKING] Read only access by consumer when dispatching a worker.-    -- Decremented by workers when picking work and undo decrement if the-    -- worker does not yield a value.-    , remainingWork  :: Maybe (IORef Count)-    , yieldRateInfo  :: Maybe YieldRateInfo--    , enqueue        :: Bool -> (RunInIO m, StreamK m a) -> IO ()-    , eagerDispatch  :: m ()-    , isWorkDone     :: IO Bool-    , isQueueDone    :: IO Bool-    , doorBellOnWorkQ   :: IORef Bool -- ring outputDoorBell on enqueue so that a-    -- sleeping consumer thread can wake up and send more workers.-    , workLoop       :: Maybe WorkerInfo -> m ()--    -- Shared, thread tracking-    -- [LOCKING] Updated unlocked, only by consumer thread.-    , workerThreads  :: IORef (Set ThreadId)--    -- [LOCKING] Updated locked, by consumer thread when dispatching a worker-    -- and by the worker threads when the thread stops. This is read unsafely-    -- at several places where we want to rely on an approximate value.-    , workerCount    :: IORef Int-    -- XXX Can we use IO instead of m here?-    , accountThread  :: ThreadId -> m ()-    , workerStopMVar :: MVar () -- Used only in ordered streams--    -- cleanup: to track garbage collection of SVar ---    , svarRef        :: Maybe (IORef ())--    -- Stats ---    , svarStats      :: SVarStats--    -- Diagnostics ---    , svarInspectMode :: Bool-    , svarCreator    :: ThreadId-    }--{-# INLINE yield #-}-yield :: Channel m a -> Maybe WorkerInfo -> a -> IO Bool-yield sv winfo x =-    sendYield-        (maxBufferLimit sv)-        (maxWorkerLimit sv)-        (workerCount sv)-        winfo-        (yieldRateInfo sv)-        (outputQueue sv)-        (outputDoorBell sv)-        (ChildYield x)--{-# INLINE stop #-}-stop :: Channel m a -> Maybe WorkerInfo -> IO ()-stop sv winfo =-    sendStop-        (workerCount sv)-        winfo-        (yieldRateInfo sv)-        (outputQueue sv)-        (outputDoorBell sv)---- | Stop the channel. Kill all running worker threads.-{-# INLINABLE stopChannel #-}-stopChannel :: MonadIO m => Channel m a -> m ()-stopChannel chan = liftIO $ do-    atomicModifyIORefCAS_ (workerCount chan) $ \n -> n - 1-    void-        $ sendWithDoorBell-            (outputQueue chan)-            (outputDoorBell chan)-            ChildStopChannel--{-# NOINLINE dumpSVar #-}-dumpSVar :: Channel m a -> IO String-dumpSVar sv = do-    xs <- sequence $ intersperse (return "\n")-        [ return (dumpCreator (svarCreator sv))-        , return "---------CURRENT STATE-----------"-        , dumpOutputQ (outputQueue sv)-        -- XXX print the types of events in the outputQueue, first 5-        , dumpDoorBell (outputDoorBell sv)-        , dumpNeedDoorBell (doorBellOnWorkQ sv)-        , dumpRunningThreads (workerThreads sv)-        -- XXX print the status of first 5 threads-        , dumpWorkerCount (workerCount sv)-        , return "---------STATS-----------\n"-        , dumpSVarStats (svarInspectMode sv) (yieldRateInfo sv) (svarStats sv)-        ]-    return $ concat xs
src/Streamly/Internal/Data/Stream/IsStream/Common.hs view
@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-orphans  #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Common@@ -661,7 +662,7 @@ -- ["h","e","l","l","o"] -- -- >>> splitOnSeq' "hello" ""--- [""]+-- [] -- -- >>> splitOnSeq' "hello" "hello" -- ["",""]
src/Streamly/Internal/Data/Stream/IsStream/Expand.hs view
@@ -1,3 +1,8 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}+ {-# OPTIONS_GHC -Wno-deprecations #-}  -- |@@ -192,6 +197,8 @@ -- $setup -- >>> :m -- >>> :set -fno-warn-deprecations+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial -- >>> import Control.Concurrent (threadDelay) -- >>> import Data.IORef -- >>> import Prelude hiding (zipWith, concatMap, concat)
src/Streamly/Internal/Data/Stream/IsStream/Generate.hs view
@@ -125,6 +125,8 @@ -- $setup -- >>> :m -- >>> :set -fno-warn-deprecations+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial -- >>> import Data.Function ((&)) -- >>> import Prelude hiding (iterate, replicate, repeat) -- >>> import qualified Streamly.Prelude as Stream
src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}  -- | -- Module      : Streamly.Internal.Data.Stream.IsStream.Reduce@@ -1103,7 +1104,7 @@     :: (IsStream t, Monad m, Ord a, Unbox a)     => Int -- window size     -> Int -- window slide-    -> Fold m (Ring a, Array a) b+    -> Fold m (RingArray a, Array a) b     -> t m a     -> t m b slidingChunkBuffer = undefined@@ -1603,8 +1604,7 @@ -- -- /Pre-release/ {-# INLINE splitInnerBy #-}-splitInnerBy-    :: (IsStream t, Monad m)+splitInnerBy :: forall t m (f :: Type -> Type) a. (IsStream t, Monad m)     => (f a -> m (f a, Maybe (f a)))  -- splitter     -> (f a -> f a -> m (f a))        -- joiner     -> t m (f a)@@ -1617,8 +1617,8 @@ -- -- /Pre-release/ {-# INLINE splitInnerBySuffix #-}-splitInnerBySuffix-    :: (IsStream t, Monad m, Eq (f a), Monoid (f a))+splitInnerBySuffix :: forall t m (f :: Type -> Type) a.+    (IsStream t, Monad m, Eq (f a), Monoid (f a))     => (f a -> m (f a, Maybe (f a)))  -- splitter     -> (f a -> f a -> m (f a))        -- joiner     -> t m (f a)
src/Streamly/Internal/Data/Stream/IsStream/Top.hs view
@@ -649,7 +649,7 @@     (a -> a -> Ordering) -> t m a -> t m a -> t m a intersectBySorted eq s1 =       IsStream.fromStreamD-    . StreamD.intersectBySorted eq (IsStream.toStreamD s1)+    . StreamD.sortedIntersectBy eq (IsStream.toStreamD s1)     . IsStream.toStreamD  -- Roughly joinLeft s1 s2 = s1 `difference` s2 + s1 `intersection` s2
src/Streamly/Internal/Data/Stream/IsStream/Transform.hs view
@@ -257,7 +257,7 @@ import qualified Streamly.Internal.Data.Stream.Parallel as Par import qualified Streamly.Internal.Data.Stream.Serial as Serial import qualified Streamly.Internal.Data.Stream as D-    (transform, foldrT, tap, tapOffsetEvery, mapM, scan+    (pipe, foldrT, tap, tapOffsetEvery, mapM, scan     , scanMany, postscan, scanlx', scanlM', scanl', postscanl', prescanl'     , prescanlM', scanl1M', scanl1', filter, filterM, uniq, deleteBy, takeWhileM     , dropWhile, dropWhileM, insertBy, intersperse@@ -298,7 +298,7 @@ -- {-# INLINE transform #-} transform :: (IsStream t, Monad m) => Pipe m a b -> t m a -> t m b-transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)+transform p xs = fromStreamD $ D.pipe p (toStreamD xs)  ------------------------------------------------------------------------------ -- Transformation Folds
src/Streamly/Internal/Data/Stream/Lifted.hs view
@@ -46,7 +46,7 @@  -- $setup -- >>> :m--- >>> import qualified Streamly.Internal.Data.Stream.Exception.Lifted as Stream+-- >>> import qualified Streamly.Internal.Data.Stream.Lifted as Stream  -- XXX Implement in terms of the corresponding IO operation (gbracketIO).
src/Streamly/Internal/Data/Stream/Parallel.hs view
@@ -61,6 +61,9 @@ import Control.Monad.Trans.Class (MonadTrans(lift)) #endif import Data.Functor (void)+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif import Data.IORef (readIORef, writeIORef) import Data.Maybe (fromJust) @@ -362,6 +365,9 @@     K.foldStreamShared st yld sng stp         $ Stream.toStreamK (SVar.teeToSVar sv $ Stream.fromStreamK m) +#if __GLASGOW_HASKELL__ >= 810+type TapState :: Type -> Type -> Type -> Type+#endif data TapState fs st a = TapInit | Tapping !fs st | TapDone st  -- | Like 'tapAsync' but uses a 'Fold' instead of a fold function.
src/Streamly/Internal/Data/Stream/Prelude.hs view
@@ -8,12 +8,18 @@ -- module Streamly.Internal.Data.Stream.Prelude     (-      module Streamly.Internal.Data.Stream.Concurrent+      -- * Concurrency Channels+      module Streamly.Internal.Data.Stream.Channel+      -- * Concurrent Streams+    , module Streamly.Internal.Data.Stream.Concurrent+      -- * Time     , module Streamly.Internal.Data.Stream.Time+      -- * Lifted     , module Streamly.Internal.Data.Stream.Lifted     ) where +import Streamly.Internal.Data.Stream.Channel import Streamly.Internal.Data.Stream.Concurrent import Streamly.Internal.Data.Stream.Time import Streamly.Internal.Data.Stream.Lifted
src/Streamly/Internal/Data/Stream/SVar.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Stream.SVar -- Copyright   : (c) 2022 Composewell Technologies
src/Streamly/Internal/Data/Stream/SVar/Eliminate.hs view
@@ -10,6 +10,7 @@ -- Eliminate a stream by distributing it to multiple SVars concurrently. -- module Streamly.Internal.Data.Stream.SVar.Eliminate+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (     -- * Concurrent Function Application       toSVarParallel
src/Streamly/Internal/Data/Stream/SVar/Generate.hs view
@@ -18,6 +18,7 @@ -- -- module Streamly.Internal.Data.Stream.SVar.Generate+    {-# DEPRECATED "SVar is replaced by Channel." #-}     (     -- * Write to SVar       toSVar@@ -112,7 +113,7 @@  -- | Pull a stream from an SVar. {-# NOINLINE fromStreamVar #-}-fromStreamVar :: MonadAsync m => SVar K.Stream m a -> K.Stream m a+fromStreamVar :: forall m a. MonadAsync m => SVar K.Stream m a -> K.Stream m a fromStreamVar sv = K.mkStream $ \st yld sng stp -> do     list <- readOutputQ sv     -- Reversing the output is important to guarantee that we process the@@ -122,6 +123,7 @@      where +    allDone :: forall r. m r -> m r     allDone stp = do         when (svarInspectMode sv) $ do             t <- liftIO $ getTime Monotonic
src/Streamly/Internal/Data/Stream/Serial.hs view
@@ -1,6 +1,12 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UndecidableInstances #-}+ {-# OPTIONS_GHC -Wno-deprecations #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}  -- | -- Module      : Streamly.Internal.Data.Stream.Serial
src/Streamly/Internal/Data/Stream/Time.hs view
@@ -25,7 +25,10 @@      -- * Chunking     , intervalsOf-    , groupsOfTimeout+    , boundedIntervalsOf+    , timedGroupsOf+    , timedChunksOf+    , timedChunksOf'      -- * Sampling     , sampleIntervalEnd@@ -48,6 +51,9 @@     , bufferLatest     , bufferLatestN     , bufferOldestN++    -- * Deprecated+    , groupsOfTimeout     ) where @@ -60,9 +66,13 @@ import Data.Maybe (isNothing) import Data.Proxy (Proxy(..)) import Streamly.Data.Fold (Fold)+import Streamly.Data.Array (Unbox)+import Streamly.Internal.Data.Array (Array) import Streamly.Internal.Data.Fold (Fold (..)) import Streamly.Internal.Data.IsMap (IsMap(..))+import Streamly.Internal.Data.Channel.Types (Rate) import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Channel.Type (rate) import Streamly.Internal.Data.Time.Units     ( AbsTime     , MilliSecond64(..)@@ -73,7 +83,9 @@ import Streamly.Internal.Data.Time.Units (NanoSecond64(..), toRelTime64)  import qualified Data.Heap as H+import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Scanl as Scanl import qualified Streamly.Data.Stream as Stream import qualified Streamly.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Fold as Fold (Step(..))@@ -140,11 +152,11 @@ -- speed. -- -- >>> tickStream = Stream.repeatM (return ())--- >>> ticksRate r = Stream.parEval (Stream.rate (Just r)) tickStream+-- >>> ticksRate r = Stream.parBuffered (Stream.rate (Just r)) tickStream -- {-# INLINE ticksRate #-} ticksRate :: MonadAsync m => Rate -> Stream m ()-ticksRate r = parEval (rate (Just r)) $ Stream.repeatM (return ())+ticksRate r = parBuffered (rate (Just r)) $ Stream.repeatM (return ())  -- XXX The case when the interval is 0, we should run only the stream being -- interjected.@@ -218,7 +230,14 @@ -- | Group the input stream into windows of @n@ second each and then fold each -- group using the provided fold function. ----- >>> twoPerSec = Stream.parEval (Stream.constRate 2) $ Stream.enumerateFrom 1+-- If the fold terminates before the interval is over, the next collection is+-- started, thus multiple collection can happen in the same interval. If the+-- fold does not terminate before the interval is over, the fold will be forced+-- to terminate at the interval end.+--+-- Example:+--+-- >>> twoPerSec = Stream.parBuffered (Stream.constRate 2) $ Stream.enumerateFrom 1 -- >>> intervals = Stream.intervalsOf 1 Fold.toList twoPerSec -- >>> Stream.fold Fold.toList $ Stream.take 2 intervals -- [...,...]@@ -230,28 +249,73 @@         (Fold.takeEndBy isNothing (Fold.catMaybes f))         (interject (return Nothing) n (fmap Just xs)) +-- | Like 'intervalsOf' but with an additional argument to limit the number of+-- collected items to a max limit. If the limit is reached, the fold output is+-- emitted and the next interval is started.+--+-- An alternative behavior would be to emit multiple elements in the same+-- interval if the size is exceeded, keeping the intervals fixed. That can be+-- achieved by using 'intervalsOf' and using a fold that terminates on the+-- limit.+--+-- /Unimplemented/+{-# INLINE boundedIntervalsOf #-}+boundedIntervalsOf :: -- MonadAsync m =>+    Int -> Double -> Int -> Fold m a b -> Stream m a -> Stream m b+boundedIntervalsOf _len _time _f _xs = undefined+ -- XXX This can be implemented more efficiently by sharing a Clock.Timer across -- parallel threads and resetting it whenever a span is emitted. --- | Like 'chunksOf' but if the chunk is not completed within the specified--- time interval then emit whatever we have collected till now. The chunk--- timeout is reset whenever a chunk is emitted. The granularity of the clock+-- | Like 'groupsOf' but if the group is not completed within the specified+-- time interval then emit whatever we have collected till now. The group+-- timeout is reset whenever a group is emitted. The granularity of the clock -- is 100 ms. --+-- Note that it will not emit any output unless at least one item has been+-- collected in the group. The time interval is only for timing out the already+-- collected but not yet complete group.+-- -- >>> s = Stream.delayPost 0.3 $ Stream.fromList [1..1000]--- >>> f = Stream.fold (Fold.drainMapM print) $ Stream.groupsOfTimeout 5 1 Fold.toList s+-- >>> f = Stream.fold (Fold.drainMapM print) $ Stream.timedGroupsOf 1 5 Fold.toList s -- -- /Pre-release/-{-# INLINE groupsOfTimeout #-}-groupsOfTimeout :: MonadAsync m-    => Int -> Double -> Fold m a b -> Stream m a -> Stream m b-groupsOfTimeout n timeout f =+{-# INLINE timedGroupsOf #-}+timedGroupsOf :: MonadAsync m+    => Double -> Int -> Fold m a b -> Stream m a -> Stream m b+timedGroupsOf timeout n f =       fmap snd     . classifySessionsBy         0.1 False (const (return False)) timeout (Fold.take n f)     . Stream.timestamped     . fmap ((),) +{-# Deprecated groupsOfTimeout "Please use timedGroupsOf instead." #-}+{-# INLINE groupsOfTimeout #-}+groupsOfTimeout :: MonadAsync m+    => Int -> Double -> Fold m a b -> Stream m a -> Stream m b+groupsOfTimeout n timeout = timedGroupsOf timeout n++-- Ideally this should be in an array module, but we do not have one in+-- streamly package.++-- | Like 'chunksOf' from the Array module but emits the chunk after the+-- timeout even if we have not yet collected the requested size.+{-# INLINE timedChunksOf #-}+timedChunksOf :: (MonadAsync m, Unbox a) =>+    Double -> Int -> Stream m a -> Stream m (Array a)+timedChunksOf timeout n = timedGroupsOf timeout n (Array.unsafeCreateOf n)++-- | Like 'timedChunksOf' but creates pinned arrays. If the chunks are smaller+-- than LARGE_OBJECT_THRESHOLD then this routine may be useful for better+-- performance if the arrays are to be sent for IO. This will avoid a copy for+-- pinning by the IO routines.+{-# INLINE timedChunksOf' #-}+timedChunksOf' :: (MonadAsync m, Unbox a) =>+    Double -> Int -> Stream m a -> Stream m (Array a)+timedChunksOf' timeout n =+    timedGroupsOf timeout n (Array.unsafeCreateOf' n)+ ------------------------------------------------------------------------------ -- Windowed classification ------------------------------------------------------------------------------@@ -317,7 +381,7 @@     :: (IsStream t, Monad m, Ord a, Unboxed a)     => Int -- window size     -> Int -- window slide-    -> Fold m (Ring a, Array a) b+    -> Fold m (RingArray a, Array a) b     -> t m a     -> t m b slidingChunkBuffer = undefined@@ -537,7 +601,7 @@     -> Stream m (Key f, b) -- ^ session key, fold result classifySessionsByGeneric _ tick reset ejectPred tmout     (Fold step initial extract final) input =-    Stream.unfoldMany (Unfold.lmap sessionOutputStream Unfold.fromStream)+    Stream.unfoldEach (Unfold.lmap sessionOutputStream Unfold.fromStream)         $ Stream.scanlMAfter' sstep (return szero) (flush final)         $ interject (return Nothing) tick         $ fmap Just input@@ -833,7 +897,7 @@     -- but the tick stream should work well as long as the timer     -- granularity is small enough compared to the gap.     Stream.mapMaybe extract-        $ Stream.scan (Fold.foldl' step BurstNone)+        $ Stream.scanl (Scanl.mkScanl step BurstNone)         $ Stream.timeIndexed         $ interject (return Nothing) 0.01 (fmap Just xs)
src/Streamly/Internal/Data/Stream/Zip.hs view
@@ -1,5 +1,11 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UndecidableInstances #-}+ {-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}  -- | -- Module      : Streamly.Internal.Data.Stream.Zip
src/Streamly/Internal/Data/Unfold/Prelude.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Unfold.Prelude -- Copyright   : (c) 2022 Composewell Technologies@@ -9,6 +11,7 @@ module Streamly.Internal.Data.Unfold.Prelude     (       module Streamly.Internal.Data.Unfold.Exception+    -- * Deprecated     , module Streamly.Internal.Data.Unfold.SVar     ) where
src/Streamly/Internal/Data/Unfold/SVar.hs view
@@ -8,6 +8,7 @@ -- Portability : GHC -- module Streamly.Internal.Data.Unfold.SVar+    {-# DEPRECATED "The functionality is moved to Channel.*" #-}     (       fromSVar     , fromProducer
src/Streamly/Internal/FileSystem/Event.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.FileSystem.Event -- Copyright   : (c) 2020 Composewell Technologies@@ -20,7 +22,12 @@ -- * "Streamly.Internal.FileSystem.Event.Linux" -- * "Streamly.Internal.FileSystem.Event.Windows" +-- XXX Need to ensure that the signatures of the exported APIs are same on all+-- platforms.++ module Streamly.Internal.FileSystem.Event+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Creating a Watch
+ src/Streamly/Internal/FileSystem/Event/Darwin.c view
@@ -0,0 +1,287 @@+/*+ * Code adapted from the Haskell "hfsevents" package.+ *+ * Copyright (c) 2012, Luite Stegeman+ *+ */++#include <config.h>++#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS++#include <CoreServices/CoreServices.h>+#include <pthread.h>+#include <unistd.h>+#include <FileSystem/Event/Darwin.h>++/*+ * For reference documentaion see:+ * https://developer.apple.com/documentation/coreservices/file_system_events?language=objc+ * https://developer.apple.com/library/archive/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html+ *+ * An OS thread is started which runs the event loop. A pipe is created+ * and the events are sent to the pipes. The receiver can read the pipe+ * output end to get the events.+ */++/******************************************************************************+ * Create Flags+ *****************************************************************************/++UInt32 FSEventStreamCreateFlagNoDefer () {+  return kFSEventStreamCreateFlagNoDefer;+}+UInt32 FSEventStreamCreateFlagWatchRoot () {+  return kFSEventStreamCreateFlagWatchRoot;+}+UInt32 FSEventStreamCreateFlagFileEvents () {+  return kFSEventStreamCreateFlagFileEvents;+}+UInt32 FSEventStreamCreateFlagIgnoreSelf () {+  return kFSEventStreamCreateFlagIgnoreSelf;+}+#if 0+UInt32 FSEventStreamCreateFlagFullHistory = kFSEventStreamCreateFlagFullHistory;+#endif++/******************************************************************************+ * Event Flags+ *****************************************************************************/++UInt32 FSEventStreamEventFlagEventIdsWrapped () {+  return kFSEventStreamEventFlagEventIdsWrapped;+}+UInt32 FSEventStreamEventFlagMustScanSubDirs () {+  return kFSEventStreamEventFlagMustScanSubDirs;+}+UInt32 FSEventStreamEventFlagKernelDropped () {+  return kFSEventStreamEventFlagKernelDropped;+}+UInt32 FSEventStreamEventFlagUserDropped () {+  return kFSEventStreamEventFlagUserDropped;+}+UInt32 FSEventStreamEventFlagHistoryDone () {+  return kFSEventStreamEventFlagHistoryDone;+}+UInt32 FSEventStreamEventFlagRootChanged () {+  return kFSEventStreamEventFlagRootChanged;+}+UInt32 FSEventStreamEventFlagMount () {+  return kFSEventStreamEventFlagMount;+}+UInt32 FSEventStreamEventFlagUnmount () {+  return kFSEventStreamEventFlagUnmount;+}+UInt32 FSEventStreamEventFlagItemChangeOwner () {+  return kFSEventStreamEventFlagItemChangeOwner;+}+UInt32 FSEventStreamEventFlagItemInodeMetaMod () {+  return kFSEventStreamEventFlagItemInodeMetaMod;+}+UInt32 FSEventStreamEventFlagItemFinderInfoMod () {+  return kFSEventStreamEventFlagItemFinderInfoMod;+}+UInt32 FSEventStreamEventFlagItemXattrMod () {+  return kFSEventStreamEventFlagItemXattrMod;+}+UInt32 FSEventStreamEventFlagItemCreated () {+  return kFSEventStreamEventFlagItemCreated;+}+UInt32 FSEventStreamEventFlagItemRemoved () {+  return kFSEventStreamEventFlagItemRemoved;+}+UInt32 FSEventStreamEventFlagItemRenamed () {+  return kFSEventStreamEventFlagItemRenamed;+}+UInt32 FSEventStreamEventFlagItemModified () {+  return kFSEventStreamEventFlagItemModified;+}+#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101300+UInt32 FSEventStreamEventFlagItemCloned () {+  return kFSEventStreamEventFlagItemCloned;+}+#endif+UInt32 FSEventStreamEventFlagItemIsDir () {+  return kFSEventStreamEventFlagItemIsDir;+}+UInt32 FSEventStreamEventFlagItemIsFile () {+  return kFSEventStreamEventFlagItemIsFile;+}+UInt32 FSEventStreamEventFlagItemIsSymlink () {+  return kFSEventStreamEventFlagItemIsSymlink;+}+#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101000+UInt32 FSEventStreamEventFlagItemIsHardlink () {+  return kFSEventStreamEventFlagItemIsHardlink;+}+#endif+UInt32 FSEventStreamEventFlagItemIsLastHardlink () {+  return kFSEventStreamEventFlagItemIsLastHardlink;+}++/******************************************************************************+ * Event watch+ *****************************************************************************/++/* Write an event to the pipe input fd */+static void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path)+{+    UInt64 buf[3];+    /* XXX Is the path string in UTF-8? */+    size_t len = strlen(path);++    buf[0] = eventId;+    buf[1] = eventFlags;+    buf[2] = (UInt64)len;+    write(fd, buf, 3 * sizeof(UInt64));+    write(fd, path, len);+}++struct watch+{+    FSEventStreamRef eventStream;+    dispatch_queue_t queue;+    int writefd;+};++/* Just writes the event to the pipe input fd */+static void watchCallback+    ( ConstFSEventStreamRef streamRef+    , void *clientCallBackInfo+    , size_t n+    , void *eventPaths+    , const FSEventStreamEventFlags eventFlags[]+    , const FSEventStreamEventId eventIds[]+    )+{+    int i;+    struct watch *w = clientCallBackInfo;+    char **paths = eventPaths;++    for (i = 0; i < n; i++) {+        writeEvent(w->writefd, eventIds[i], eventFlags[i], paths[i]);+    }+}++#define MAX_WATCH_PATHS 4096++static void free_cffolders(CFStringRef *cffolders, int n) {+    int i;+    for (i = 0; i < n; i++) {+        CFRelease (cffolders[i]);+    }+    free(cffolders);+}++int createWatch+    ( struct pathName* folders+    , int n  /* number of entries in folders */+    , UInt32 createFlags+    , UInt64 since+    , double latency+    , int* fd+    , void** wp+    )+{+    if (n > MAX_WATCH_PATHS) {+      return -1;+    }++    int pfds[2];+    if (pipe (pfds)) {+      return -1;+    }++    /*+     * XXX We can possibly use since == 0 to get all events since+     * beginning of time+     */+    if (!since) {+      since = kFSEventStreamEventIdSinceNow;+    }++    struct watch *w = malloc(sizeof(struct watch));+    if (!w) {+      goto cleanup_pipe;+    }++    /* Setup paths array */+    CFStringRef *cffolders = malloc(n * sizeof(CFStringRef));+    if (!cffolders) {+      goto cleanup_watch;+    }++    /* Create event stream using paths and context*/+    int i;+    for(i = 0; i < n; i++) {+      cffolders[i] = CFStringCreateWithBytes+          ( NULL+          , folders[i].pathBytes+          , folders[i].pathLen+          , kCFStringEncodingUTF8+          , false+          );+      if (!cffolders[i]) {+          free_cffolders(cffolders, i);+          goto cleanup_watch;+      }+    }+    CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);+    if (!paths) {+      free_cffolders(cffolders, n);+      goto cleanup_watch;+    }++    FSEventStreamContext ctx;+    ctx.version = 0;+    ctx.info = (void*)w;+    ctx.retain = NULL;+    ctx.release = NULL;+    ctx.copyDescription = NULL;++    w->eventStream = FSEventStreamCreate+        (NULL, &watchCallback, &ctx, paths, since, latency, createFlags);+    free_cffolders(cffolders, n);+    CFRelease(paths);++    if(w->eventStream == NULL) {+      goto cleanup_watch;+    }++    w->queue = dispatch_queue_create("com.composewell.streamly", NULL);+    if (!w->queue) {+      goto cleanup_es;+    }++    w->writefd = pfds[1];+    *fd = pfds[0];+    *wp = w;+    FSEventStreamSetDispatchQueue(w->eventStream, w->queue);+    FSEventStreamStart(w->eventStream);+    return 0;++cleanup_es:+    FSEventStreamRelease(w->eventStream);+cleanup_watch:+    free(w);+cleanup_pipe:+    close(pfds[0]);+    close(pfds[1]);+    return -1;+}++/******************************************************************************+ * Stop a watch event loop+ *****************************************************************************/++void destroyWatch(struct watch* w) {+    /* Stop and invalidate the event stream */+    FSEventStreamFlushSync(w->eventStream);+    FSEventStreamStop(w->eventStream);+    FSEventStreamInvalidate(w->eventStream);+    dispatch_release(w->queue);+    FSEventStreamRelease(w->eventStream);+    close(w->writefd);+    free(w);+}+#endif
src/Streamly/Internal/FileSystem/Event/Darwin.hs view
@@ -87,6 +87,7 @@ #if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS  module Streamly.Internal.FileSystem.Event.Darwin+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Creating a Watch @@ -451,8 +452,8 @@      withPathName :: Array Word8 -> (PathName -> IO a) -> IO a     withPathName arr act = do-        A.unsafePinnedAsPtr arr $ \ptr ->-            let pname = PathName (castPtr ptr) (fromIntegral (A.length arr))+        A.unsafePinnedAsPtr arr $ \ptr byteLen ->+            let pname = PathName (castPtr ptr) (fromIntegral byteLen)             in act pname      withPathNames = contListMap withPathName withArray@@ -491,12 +492,12 @@ -- readOneEvent :: Parser Word8 IO Event readOneEvent = do-    arr <- PR.takeEQ 24 (A.writeN 24)-    let arr1 = A.castUnsafe arr :: Array Word64-        eid = A.getIndexUnsafe 0 arr1-        eflags = A.getIndexUnsafe 1 arr1-        pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1-    path <- PR.takeEQ pathLen (A.writeN pathLen)+    arr <- PR.takeEQ 24 (A.createOf 24)+    let arr1 = A.unsafeCast arr :: Array Word64+        eid = A.unsafeGetIndex 0 arr1+        eflags = A.unsafeGetIndex 1 arr1+        pathLen = fromIntegral $ A.unsafeGetIndex 2 arr1+    path <- PR.takeEQ pathLen (A.createOf pathLen)     return $ Event         { eventId = eid         , eventFlags = fromIntegral eflags@@ -1036,7 +1037,7 @@ -- | Convert an 'Event' record to a String representation. showEvent :: Event -> String showEvent ev@Event{..} =-    let path = runIdentity $ S.fold FL.toList $ U.decodeUtf8' $ A.toStream eventAbsPath+    let path = runIdentity $ S.fold FL.toList $ U.decodeUtf8' $ A.read eventAbsPath     in "--------------------------"         ++ "\nId = " ++ show eventId         ++ "\nPath = " ++ show path
− src/Streamly/Internal/FileSystem/Event/Darwin.m 
@@ -1,294 +0,0 @@-/*- * Code adapted from the Haskell "hfsevents" package.- *- * Copyright (c) 2012, Luite Stegeman- *- */--#include <config.h>--#if HAVE_DECL_KFSEVENTSTREAMCREATEFLAGFILEEVENTS--#include <CoreServices/CoreServices.h>-#include <pthread.h>-#include <unistd.h>-#include <FileSystem/Event/Darwin.h>--/*- * For reference documentaion see:- * https://developer.apple.com/documentation/coreservices/file_system_events?language=objc- * https://developer.apple.com/library/archive/documentation/Darwin/Conceptual/FSEvents_ProgGuide/UsingtheFSEventsFramework/UsingtheFSEventsFramework.html- *- * An OS thread is started which runs the event loop. A pipe is created- * and the events are sent to the pipes. The receiver can read the pipe- * output end to get the events.- */--/******************************************************************************- * Create Flags- *****************************************************************************/--UInt32 FSEventStreamCreateFlagNoDefer () {-  return kFSEventStreamCreateFlagNoDefer;-}-UInt32 FSEventStreamCreateFlagWatchRoot () {-  return kFSEventStreamCreateFlagWatchRoot;-}-UInt32 FSEventStreamCreateFlagFileEvents () {-  return kFSEventStreamCreateFlagFileEvents;-}-UInt32 FSEventStreamCreateFlagIgnoreSelf () {-  return kFSEventStreamCreateFlagIgnoreSelf;-}-#if 0-UInt32 FSEventStreamCreateFlagFullHistory = kFSEventStreamCreateFlagFullHistory;-#endif--/******************************************************************************- * Event Flags- *****************************************************************************/--UInt32 FSEventStreamEventFlagEventIdsWrapped () {-  return kFSEventStreamEventFlagEventIdsWrapped;-}-UInt32 FSEventStreamEventFlagMustScanSubDirs () {-  return kFSEventStreamEventFlagMustScanSubDirs;-}-UInt32 FSEventStreamEventFlagKernelDropped () {-  return kFSEventStreamEventFlagKernelDropped;-}-UInt32 FSEventStreamEventFlagUserDropped () {-  return kFSEventStreamEventFlagUserDropped;-}-UInt32 FSEventStreamEventFlagHistoryDone () {-  return kFSEventStreamEventFlagHistoryDone;-}-UInt32 FSEventStreamEventFlagRootChanged () {-  return kFSEventStreamEventFlagRootChanged;-}-UInt32 FSEventStreamEventFlagMount () {-  return kFSEventStreamEventFlagMount;-}-UInt32 FSEventStreamEventFlagUnmount () {-  return kFSEventStreamEventFlagUnmount;-}-UInt32 FSEventStreamEventFlagItemChangeOwner () {-  return kFSEventStreamEventFlagItemChangeOwner;-}-UInt32 FSEventStreamEventFlagItemInodeMetaMod () {-  return kFSEventStreamEventFlagItemInodeMetaMod;-}-UInt32 FSEventStreamEventFlagItemFinderInfoMod () {-  return kFSEventStreamEventFlagItemFinderInfoMod;-}-UInt32 FSEventStreamEventFlagItemXattrMod () {-  return kFSEventStreamEventFlagItemXattrMod;-}-UInt32 FSEventStreamEventFlagItemCreated () {-  return kFSEventStreamEventFlagItemCreated;-}-UInt32 FSEventStreamEventFlagItemRemoved () {-  return kFSEventStreamEventFlagItemRemoved;-}-UInt32 FSEventStreamEventFlagItemRenamed () {-  return kFSEventStreamEventFlagItemRenamed;-}-UInt32 FSEventStreamEventFlagItemModified () {-  return kFSEventStreamEventFlagItemModified;-}-#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101300-UInt32 FSEventStreamEventFlagItemCloned () {-  return kFSEventStreamEventFlagItemCloned;-}-#endif-UInt32 FSEventStreamEventFlagItemIsDir () {-  return kFSEventStreamEventFlagItemIsDir;-}-UInt32 FSEventStreamEventFlagItemIsFile () {-  return kFSEventStreamEventFlagItemIsFile;-}-UInt32 FSEventStreamEventFlagItemIsSymlink () {-  return kFSEventStreamEventFlagItemIsSymlink;-}-#if __MAC_OS_X_VERSION_MIN_REQUIRED >= 101000-UInt32 FSEventStreamEventFlagItemIsHardlink () {-  return kFSEventStreamEventFlagItemIsHardlink;-}-#endif-UInt32 FSEventStreamEventFlagItemIsLastHardlink () {-  return kFSEventStreamEventFlagItemIsLastHardlink;-}--/******************************************************************************- * Event watch- *****************************************************************************/--/* Write an event to the pipe input fd */-static void writeEvent(int fd, UInt64 eventId, UInt64 eventFlags, char* path) -{-    UInt64 buf[3];-    buf[0] = eventId;-    buf[1] = eventFlags;-    /* XXX Is the path string in UTF-8? */-    buf[2] = (UInt64)strlen(path);-    write(fd, buf, 3 * sizeof(UInt64));-    write(fd, path, strlen(path));-}--/* thread state */-struct watch-{-    FSEventStreamRef eventStream;-    CFRunLoopRef runLoop;-    int writefd;-    pthread_mutex_t mut;-};--/* Just writes the event to the pipe input fd */-static void watchCallback-    ( ConstFSEventStreamRef streamRef-    , void *clientCallBackInfo-    , size_t n-    , void *eventPaths-    , const FSEventStreamEventFlags eventFlags[]-    , const FSEventStreamEventId eventIds[]-    )-{-    int i;-    struct watch *w = clientCallBackInfo;-    char **paths = eventPaths;--    for (i = 0; i < n; i++) {-        writeEvent(w->writefd, eventIds[i], eventFlags[i], paths[i]);-    }-}--/******************************************************************************- * Start a watch event loop- *****************************************************************************/--/* Event loop run in a pthread */-static void *watchRunLoop(void *vw)-{-    struct watch* w = (struct watch*) vw;-    CFRunLoopRef rl = CFRunLoopGetCurrent();-    CFRetain(rl);-    w->runLoop = rl;-    FSEventStreamScheduleWithRunLoop(w->eventStream, rl, kCFRunLoopDefaultMode);-    FSEventStreamStart(w->eventStream);-    pthread_mutex_unlock(&w->mut);-    CFRunLoopRun();-    pthread_exit(NULL);-}--#define MAX_WATCH_PATHS 4096--int createWatch-    ( struct pathName* folders-    , int n  /* number of entries in folders */-    , UInt32 createFlags-    , UInt64 since-    , double latency-    , int* fd-    , void** wp-    )-{-    if (n > MAX_WATCH_PATHS) {-      return -1;-    }--    int pfds[2];-    if (pipe (pfds)) {-      return -1;-    }--    /*-     * XXX We can possibly use since == 0 to get all events since-     * beginning of time-     */-    if (!since) {-      since = kFSEventStreamEventIdSinceNow;-    }--    /* Setup paths array */-    CFStringRef *cffolders = malloc(n * sizeof(CFStringRef));-    int i;-    for(i = 0; i < n; i++) {-      cffolders[i] = CFStringCreateWithBytes-          ( NULL-          , folders[i].pathBytes-          , folders[i].pathLen-          , kCFStringEncodingUTF8-          , false-          );-    }-    CFArrayRef paths = CFArrayCreate(NULL, (const void **)cffolders, n, NULL);--    /* Setup context */-    struct watch *w = malloc(sizeof(struct watch));-    FSEventStreamContext ctx;-    ctx.version = 0;-    ctx.info = (void*)w;-    ctx.retain = NULL;-    ctx.release = NULL;-    ctx.copyDescription = NULL;--    /* Create watch using paths and context*/-    FSEventStreamRef es = FSEventStreamCreate-        (NULL, &watchCallback, &ctx, paths, since, latency, createFlags);--    /* Run the event loop in a pthread */-    int retval;-    if(es != NULL) {-        /* Success */-        w->writefd = pfds[1];-        w->eventStream = es;-        w->runLoop = NULL;--        /* Lock to prevent race against watch destroy */-        pthread_mutex_init(&w->mut, NULL);-        pthread_mutex_lock(&w->mut);-        pthread_t t;-        pthread_create(&t, NULL, &watchRunLoop, (void*)w);--        /* return the out fd and the watch struct */-        *fd = pfds[0];-        *wp = w;-        retval = 0;-    } else {-        /* Failure */-        close(pfds[0]);-        close(pfds[1]);-        free(w);-        retval = -1;-    }--    /* Cleanup */-    for (i = 0; i < n; i++) {-        CFRelease (cffolders[i]);-    }-    free(cffolders);-    CFRelease(paths);-    return retval;-}--/******************************************************************************- * Stop a watch event loop- *****************************************************************************/--void destroyWatch(struct watch* w) {-    /* Stop the loop so the thread will exit */-    pthread_mutex_lock(&w->mut);-    FSEventStreamStop(w->eventStream);-    FSEventStreamInvalidate(w->eventStream);-    CFRunLoopStop(w->runLoop);-    CFRelease(w->runLoop);-    FSEventStreamRelease(w->eventStream);-    close(w->writefd);-    pthread_mutex_unlock(&w->mut);--    /* Cleanup */-    pthread_mutex_destroy(&w->mut);-    free(w);-}-#endif
src/Streamly/Internal/FileSystem/Event/Linux.hs view
@@ -59,6 +59,7 @@  #if HAVE_DECL_IN_EXCL_UNLINK module Streamly.Internal.FileSystem.Event.Linux+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Subscribing to events @@ -169,7 +170,7 @@ import Foreign.Ptr (Ptr) import Foreign.Storable (peek, peekByteOff, sizeOf) import GHC.IO.Device (IODeviceType(Stream))-import GHC.IO.FD (fdFD, mkFD)+import GHC.IO.FD (fdFD, FD(..)) import GHC.IO.Handle.FD (mkHandleFromFD) import Streamly.Data.Stream (Stream) import Streamly.Data.Parser (Parser)@@ -178,20 +179,23 @@ import GHC.IO.Handle.FD (handleToFd)  import Streamly.Internal.Data.Array (Array(..), byteLength)+import Streamly.Internal.FileSystem.Path (Path)  import qualified Data.IntMap.Lazy as Map import qualified Data.List.NonEmpty as NonEmpty import qualified Streamly.Data.Fold as FL-import qualified Streamly.Data.Array as A (fromList, writeN, getIndex)+import qualified Streamly.Data.Array as A (fromList, createOf, getIndex) import qualified Streamly.Data.Stream as S import qualified Streamly.FileSystem.Handle as FH import qualified Streamly.Unicode.Stream as U+import qualified Streamly.Internal.FileSystem.Path as Path  import qualified Streamly.Internal.Data.Array as A-    ( fromStream, asCStringUnsafe, unsafePinnedAsPtr-    , getSliceUnsafe, read+    ( asCStringUnsafe, unsafePinnedAsPtr+    , unsafeSliceOffLen, read     )-import qualified Streamly.Internal.FileSystem.Dir as Dir (readDirs)+import qualified Streamly.Internal.FileSystem.DirIO as Dir+    (readDirs, followSymlinks) import qualified Streamly.Internal.Data.Parser as PR     (takeEQ, fromEffect, fromFold) @@ -575,6 +579,7 @@  newtype WD = WD CInt deriving Show +-- XXX Use inotify_init1? and IN_NONBLOCK? foreign import ccall unsafe     "sys/inotify.h inotify_init" c_inotify_init :: IO CInt @@ -586,23 +591,34 @@ createWatch :: IO Watch createWatch = do     rawfd <- throwErrnoIfMinus1 "createWatch" c_inotify_init-    -- we could use fdToHandle but it cannot determine the fd type-    -- automatically for the inotify fd-    (fd, fdType) <--        mkFD-            rawfd-            ReadMode-            (Just (Stream, 0, 0))  -- (IODeviceType, CDev, CIno)-            False                  -- not a socket-            False                  -- non-blocking is false-    let fdString = "<createWatch file descriptor: " ++ show fd ++ ">"+    -- We could use fdToHandle but it cannot determine the fd type+    -- automatically for the inotify fd because fdStat fails for Stream type+    -- fd.+    --+    -- Do not use mkFD as it locks a regular file causing "resource busy" error+    -- in some test cases.+    let fd =+            FD+                { fdFD = rawfd+#if !defined(mingw32_HOST_OS)+                , fdIsNonBlocking = 0+#else+                , fdIsSocket_ = 0+#endif+              }++    -- XXX Do we need non-blocking IO?+    -- With non-blocking IO it fails because GHC-9.10 uses fdStat in+    -- FD.setNonBlockingMode to determine the fd type which fails for Stream+    -- type fd. However, without non-blocking IO "select" has a limitation on+    -- the number of FDs being watched (1024).     h <-         mkHandleFromFD            fd-           fdType-           fdString+           Stream+           ("<createWatch fd: " ++ show fd ++ ">")            ReadMode-           True    -- use non-blocking IO+           False    -- use non-blocking IO            Nothing -- TextEncoding (binary)     emptyMapRef <- newIORef Map.empty     return $ Watch h emptyMapRef@@ -615,8 +631,8 @@ -- separated bytes. So these may fail or convert the path in an unexpected -- manner. We should ultimately remove all usage of these. -toUtf8 :: MonadIO m => String -> m (Array Word8)-toUtf8 = A.fromStream . U.encodeUtf8 . S.fromList+toUtf8 :: MonadIO m => Path -> m (Array Word8)+toUtf8 path = pure $ Path.toArray path  utf8ToString :: Array Word8 -> String utf8ToString = runIdentity . S.fold FL.toList . U.decodeUtf8' . A.read@@ -649,7 +665,7 @@             Nothing -> error "removeTrailingSlash: Bug: Invalid index"             Just x ->                 if x == fromIntegral (ord '/')-                then A.getSliceUnsafe 0 n path+                then A.unsafeSliceOffLen 0 n path                 else path     else path @@ -716,12 +732,14 @@     --     -- XXX readDirs currently uses paths as String, we need to convert it     -- to "/" separated by byte arrays.-    pathIsDir <- doesDirectoryExist $ utf8ToString absPath+    let p = Path.unsafeFromArray absPath+    -- XXX Need a FileSystem.Stat module to remove this+    pathIsDir <- doesDirectoryExist (Path.toString p)     when (watchRec && pathIsDir) $ do         let f = addToWatch cfg watch0 root . appendPaths path             in S.fold (FL.drainMapM f)                 $ S.mapM toUtf8-                $ Dir.readDirs $ utf8ToString absPath+                $ Dir.readDirs (Dir.followSymlinks True) p  foreign import ccall unsafe     "sys/inotify.h inotify_rm_watch" c_inotify_rm_watch@@ -808,7 +826,7 @@ readOneEvent :: Config -> Watch -> Parser Word8 IO Event readOneEvent cfg  wt@(Watch _ wdMap) = do     let headerLen = sizeOf (undefined :: CInt) + 12-    arr <- PR.takeEQ headerLen (A.writeN headerLen)+    arr <- PR.takeEQ headerLen (A.createOf headerLen)     (ewd, eflags, cookie, pathLen) <- PR.fromEffect $ A.unsafePinnedAsPtr arr readHeader     -- XXX need the "initial" in parsers to return a step type so that "take 0"     -- can return without an input. otherwise if pathLen is 0 we will keep@@ -822,7 +840,7 @@             pth <-                 PR.fromFold                     $ FL.takeEndBy_ (== 0)-                    $ FL.take pathLen (A.writeN pathLen)+                    $ FL.take pathLen (A.createOf pathLen)             let remaining = pathLen - byteLength pth - 1             when (remaining /= 0) $ PR.takeEQ remaining FL.drain             return pth@@ -854,7 +872,7 @@      where -    readHeader (ptr :: Ptr Word8) = do+    readHeader (ptr :: Ptr Word8) _ = do         let len = sizeOf (undefined :: CInt)         ewd <- peek ptr         eflags <- peekByteOff ptr len
src/Streamly/Internal/FileSystem/Event/Windows.hs view
@@ -43,6 +43,7 @@ -- * Minimum supported server: Windows Server 2003 [desktop apps | UWP apps  module Streamly.Internal.FileSystem.Event.Windows+    {-# DEPRECATED "Use the streamly-fsevents package." #-}     (     -- * Subscribing to events
src/Streamly/Internal/FileSystem/FD.hs view
@@ -218,20 +218,17 @@ {-# INLINABLE readArrayUpto #-} readArrayUpto :: Int -> Handle -> IO (Array Word8) readArrayUpto size (Handle fd) = do-    arr <- MArray.pinnedNewBytes size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    MArray.unsafePinnedAsPtr arr $ \p -> do-        -- n <- hGetBufSome h p size+    arr <-+        MArray.unsafeCreateWithPtr' size $ \p ->+             -- n <- hGetBufSome h p size #if MIN_VERSION_base(4,15,0)-        n <- RawIO.read fd p 0 size+            RawIO.read fd p 0 size #else-        n <- RawIO.read fd p size+            RawIO.read fd p size #endif-        -- XXX shrink only if the diff is significant-        -- Use unsafeFreezeWithShrink-        return-            $ unsafeFreeze-            $ arr { MArray.arrEnd = n, MArray.arrBound = size }+    -- XXX shrink only if the diff is significant+    -- Use unsafeFreezeWithShrink+    pure $ unsafeFreeze arr  ------------------------------------------------------------------------------- -- Array IO (output)
src/Streamly/Internal/Network/Inet/TCP.hs view
@@ -73,6 +73,7 @@      -- ** Transformation     , pipeBytes+    , pipeChunks     {-     -- ** Sink Servers @@ -132,7 +133,7 @@ import qualified Streamly.Data.Stream as S import qualified Streamly.Data.Unfold as UF import qualified Streamly.Internal.Data.Array as A-    (pinnedChunksOf, unsafePinnedCreateOf)+    (chunksOf', unsafeCreateOf') import qualified Streamly.Internal.Data.Unfold as UF (bracketIO) import qualified Streamly.Internal.Data.Fold as FL (Step(..), reduce) @@ -345,11 +346,11 @@ {-# INLINE reader #-} reader :: (MonadCatch m, MonadAsync m)     => Unfold m ((Word8, Word8, Word8, Word8), PortNumber) Word8-reader = UF.many A.reader (usingConnection ISK.chunkReader)+reader = UF.unfoldEach A.reader (usingConnection ISK.chunkReader)  {-# INLINE concatChunks #-} concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader+concatChunks = S.unfoldEach A.reader  -- | Read a stream from the supplied IPv4 host address and port number. --@@ -421,7 +422,7 @@     -> Stream m Word8     -> m () putBytesWithBufferOf n addr port m =-    putChunks addr port $ A.pinnedChunksOf n m+    putChunks addr port $ A.chunksOf' n m  -- | Like 'write' but provides control over the write buffer. Output will -- be written to the IO device as soon as we collect the specified number of@@ -435,7 +436,7 @@     -> PortNumber     -> Fold m Word8 () writeWithBufferOf n addr port =-    FL.groupsOf n (A.unsafePinnedCreateOf n) (writeChunks addr port)+    FL.groupsOf n (A.unsafeCreateOf' n) (writeChunks addr port)  -- | Write a stream to the supplied IPv4 host address and port number. --@@ -461,19 +462,20 @@     :: (MonadCatch m, MonadAsync m)     => (Word8, Word8, Word8, Word8)     -> PortNumber-    -> Stream m Word8+    -> Stream m a     -> (Socket -> Stream m a)+    -> (Socket -> Stream m a -> m ())     -> Stream m a-withInputConnect addr port input f = S.bracket pre post handler+withInputConnect addr port input fread fwrite = S.bracket pre post handler      where      pre = do         sk <- liftIO $ connect addr port-        tid <- fork (ISK.putBytes sk input)+        tid <- fork (fwrite sk input)         return (sk, tid) -    handler (sk, _) = f sk+    handler (sk, _) = fread sk      -- XXX kill the thread immediately?     post (sk, _) = liftIO $ Net.close sk@@ -491,4 +493,17 @@     -> PortNumber     -> Stream m Word8     -> Stream m Word8-pipeBytes addr port input = withInputConnect addr port input ISK.read+pipeBytes addr port input = withInputConnect addr port input ISK.read ISK.putBytes++-- | This is similar to pipeBytes, but works on chunks of data.+--+-- /Pre-release/+--+{-# INLINE pipeChunks #-}+pipeChunks+    :: (MonadAsync m, MonadCatch m)+    => (Word8, Word8, Word8, Word8)+    -> PortNumber+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+pipeChunks addr port input = withInputConnect addr port input ISK.readChunks ISK.putChunks
src/Streamly/Internal/Network/Socket.hs view
@@ -98,10 +98,10 @@ import qualified Streamly.Data.Stream as S import qualified Streamly.Data.Unfold as UF import qualified Streamly.Internal.Data.Array as A-    ( unsafeFreeze, unsafePinnedAsPtr, byteLength, pinnedChunksOf,-      pinnedCreateOf, unsafePinnedCreateOf, lCompactGE )+    ( unsafeFreeze, unsafePinnedAsPtr, chunksOf',+      createOf', unsafeCreateOf, scanCompactMin ) import qualified Streamly.Internal.Data.MutArray as MArray-    (MutArray(..), unsafePinnedAsPtr, pinnedEmptyOf)+    (unsafeCreateWithPtr') import qualified Streamly.Internal.Data.Stream as S (fromStreamK, Stream(..), Step(..)) import qualified Streamly.Internal.Data.StreamK as K (mkStream) @@ -261,16 +261,10 @@     -> h     -> IO (Array Word8) readArrayUptoWith f size h = do-    arr <- MArray.pinnedEmptyOf size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    MArray.unsafePinnedAsPtr arr $ \p -> do-        n <- f h p size-        let v = A.unsafeFreeze-                $ arr { MArray.arrEnd = n, MArray.arrBound = size }--        -- XXX shrink only if the diff is significant-        -- A.shrinkToFit v-        return v+    arr <- MArray.unsafeCreateWithPtr' size $ \p -> f h p size+    -- XXX shrink only if the diff is significant+    -- unsafeFreezeWithShrink+    pure $ A.unsafeFreeze arr  -- | Read a byte array from a file handle up to a maximum of the requested -- size. If no data is available on the handle it blocks until some data@@ -311,11 +305,8 @@     -> Array a     -> IO () writeArrayWith _ _ arr | A.length arr == 0 = return ()-writeArrayWith f h arr = A.unsafePinnedAsPtr arr $ \ptr -> f h (castPtr ptr) aLen--    where--    aLen = A.byteLength arr+writeArrayWith f h arr =+    A.unsafePinnedAsPtr arr $ \ptr byteLen -> f h (castPtr ptr) byteLen  -- | Write an Array to a socket. --@@ -407,7 +398,7 @@  {-# INLINE concatChunks #-} concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader+concatChunks = S.unfoldEach A.reader  -- | Generate a byte stream from a socket using a buffer of the given size. --@@ -430,7 +421,7 @@ -- {-# INLINE readerWith #-} readerWith :: MonadIO m => Unfold m (Int, Socket) Word8-readerWith = UF.many A.reader chunkReaderWith+readerWith = UF.unfoldEach A.reader chunkReaderWith  -- | Same as 'readWith' --@@ -474,7 +465,10 @@ {-# INLINE writeChunksWith #-} writeChunksWith :: (MonadIO m, Unbox a)     => Int -> Socket -> Fold m (Array a) ()-writeChunksWith n h = A.lCompactGE n (writeChunks h)+-- writeChunksWith n h = A.lCompactBySizeGE n (writeChunks h)+writeChunksWith n h =+   FL.postscanl (A.scanCompactMin n)+    $ FL.catMaybes (writeChunks h)  -- | Same as 'writeChunksWith' --@@ -498,14 +492,14 @@ -- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Socket -> Stream m Word8 -> m ()-putBytesWith n h m = putChunks h $ A.pinnedChunksOf n m+putBytesWith n h m = putChunks h $ A.chunksOf' n m  -- | Write a byte stream to a socket. Accumulates the input in chunks of -- specified number of bytes before writing. -- {-# INLINE writeWith #-} writeWith :: MonadIO m => Int -> Socket -> Fold m Word8 ()-writeWith n h = FL.groupsOf n (A.unsafePinnedCreateOf n) (writeChunks h)+writeWith n h = FL.groupsOf n (A.unsafeCreateOf n) (writeChunks h)  -- | Same as 'writeWith' --@@ -523,7 +517,7 @@ writeMaybesWith :: (MonadIO m )     => Int -> Socket -> Fold m (Maybe Word8) () writeMaybesWith n h =-    let writeNJusts = FL.lmap fromJust $ A.pinnedCreateOf n+    let writeNJusts = FL.lmap fromJust $ A.createOf' n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h)
+ src/deprecation.h view
@@ -0,0 +1,9 @@+#define RENAME(_old, _new)                          \+{-# DEPRECATED _old "Please use _new instead." #-}; \+{-# INLINE _old #-}; \+_old = _new++#define RENAME_PRIME(_old, _new)                       \+{-# DEPRECATED _old "Please use _new' instead." #-}; \+{-# INLINE _old #-}; \+_old = _new'
+ src/doctest/DocTestDataFold.hs view
@@ -0,0 +1,19 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Concurrent (threadDelay)+>>> import Data.List (sortOn)+>>> import Data.HashMap.Strict (HashMap)++>>> import Streamly.Data.Fold (Fold)+>>> import Streamly.Data.Stream (Stream)++>>> import qualified Data.HashMap.Strict as HM+>>> import qualified Streamly.Data.Fold.Prelude as Fold+>>> import qualified Streamly.Data.Stream.Prelude as Stream++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Fold.Prelude as Fold+-}
+ src/doctest/DocTestDataScanl.hs view
@@ -0,0 +1,7 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Concurrent (threadDelay)+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.Scanl.Prelude as Scanl+-}
streamly.cabal view
@@ -1,49 +1,45 @@-cabal-version:      2.2+cabal-version:      2.4 name:               streamly-version:            0.10.1-synopsis:           Streaming, dataflow programming and declarative concurrency+version:            0.11.0+synopsis:           Streaming data pipelines with declarative concurrency description:   For upgrading to streamly-0.9.0+ please read the   <https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md Streamly-0.9.0 upgrade guide>.   .-  Streamly is a standard library for Haskell that focuses on C-like-  performance, modular combinators, and streaming data flow model.-  Streamly consists of two packages, the-  <https://hackage.haskell.org/package/streamly-core streamly-core> package-  provides functionality that depends only on boot libraries, and-  the <https://hackage.haskell.org/package/streamly streamly> package-  provides additional functionality like concurrency, time, lifted-  exceptions, and networking.  For unified documentation visit-  <https://streamly.composewell.com the streamly website>.+  Streamly is a high-performance, beginner-friendly standard library+  for Haskell. It unifies streaming with list transformers and logic+  programming; unifies streaming with concurrency and reactive+  programming; unifies arrays with ring arrays, text, bytestring+  and vector use cases; unifies arrays with builders and binary+  serialization; generalizes parsers to any input type and unifies+  attoparsec, parsec use cases with better performance; provides+  streaming fileIO — all with a clean, consistent, well-integrated and+  streaming enabled API.   .-  Streamly provides unified, modular building blocks to build-  high-performance, concurrent, scalable applications in Haskell.  Stream-  fusion optimizations in streamly enable exceptional modularity with-  high performance comparable to C. Streamly complements the Haskell-  <https://hackage.haskell.org/package/base base> package, supplying-  additional functionality to quickly build general-purpose applications-  in Haskell. For high-level functionality built over streamly like-  streaming OS processes, shell programming, GNU coreutils,-  statistics, and compression libraries please see the-  <https://streamly.composewell.com/ecosystem.html streamly ecosystem packages>.+  Streams are designed to have a list like interface — no steep+  learning curve, no complex types. Streamly is designed to build+  general purpose applications in a truly functional manner, from+  simple hello-world to advanced high-performance systems. The design+  emphasizes simplicity, modularity, and code reuse with minimal+  building blocks. Performance is on par with C, tuning is easy, and+  it’s hard to get it wrong.   .-  Performance with modularity:+  Streamly is serial by default, with seamless declarative concurrency+  that scales automatically when needed. It provides prompt and safe+  resource management, works well with other streaming libraries as well+  as core libraries like bytestring and text, and is backed by solid+  documentation.   .-  * Performance on par with C (<https://github.com/composewell/streaming-benchmarks Benchmarks>)-  * API close to standard Haskell lists (<https://github.com/composewell/streamly-examples Examples>)-  * Declarative concurrency with automatic scaling-  * Filesystem, fsnotify, network, and Unicode support included-  * Fast binary serialization (with optional JSON like features)-  * More functionality is provided via many (<https://streamly.composewell.com/ecosystem.html ecosystem packages>)+  The @streamly@ package is built on top of the @streamly-core@ package+  and offers high-level capabilities such as concurrency, reactive+  programming, time-related combinators, lifted exceptions, and+  networking. It provides streaming with concurrency, and is a more+  powerful, higher-level and more expressive alternative to the @async@+  package.   .-  Unified and powerful abstractions:+  Performant. Unified. Modular. Powerful. Simple.   .-  * Unifies streams, arrays, folds, and parsers-  * Unifies @Data.List@, @list-t@, and @logict@ with streaming-  * Unifies concurrency with standard streaming abstractions-  * Unifies reactive, time-domain programming with streaming-  * Unifies binary serialization and unboxed arrays-  * Interworks with other streaming libraries+  Learn more at <https://streamly.composewell.com the streamly website>.  homepage:            https://streamly.composewell.com bug-reports:         https://github.com/composewell/streamly/issues@@ -57,6 +53,8 @@                    , GHC==9.4.7                    , GHC==9.6.3                    , GHC==9.8.1+                   , GHC==9.10.1+                   , GHC==9.12.1 author:              Composewell Technologies maintainer:          streamly@composewell.com copyright:           2017 Composewell Technologies@@ -68,21 +66,26 @@ build-type:          Configure  extra-source-files:+    bench-test-lib/bench-test-lib.cabal+    bench-test-lib/src/BenchTestLib/DirIO.hs     benchmark/*.hs     benchmark/bench-runner/Main.hs     benchmark/bench-runner/bench-runner.cabal     benchmark/Streamly/Benchmark/Data/*.hs+    benchmark/Streamly/Benchmark/Data/Scanl/*.hs+    benchmark/Streamly/Benchmark/Data/Fold/*.hs     benchmark/Streamly/Benchmark/Data/Serialize/*.hs     benchmark/Streamly/Benchmark/Data/Array/Common.hs     benchmark/Streamly/Benchmark/Data/Array/CommonImports.hs     benchmark/Streamly/Benchmark/Data/Array/Generic.hs     benchmark/Streamly/Benchmark/Data/Array/SmallArray.hs     benchmark/Streamly/Benchmark/Data/Array.hs-    benchmark/Streamly/Benchmark/Data/Ring/Unboxed.hs+    benchmark/Streamly/Benchmark/Data/RingArray.hs     benchmark/Streamly/Benchmark/Data/MutArray.hs     benchmark/Streamly/Benchmark/Data/Array/Stream.hs     benchmark/Streamly/Benchmark/Data/Fold/Window.hs     benchmark/Streamly/Benchmark/Data/Stream/*.hs+    benchmark/Streamly/Benchmark/Data/StreamK/*.hs     benchmark/Streamly/Benchmark/FileSystem/*.hs     benchmark/Streamly/Benchmark/FileSystem/Handle/*.hs     benchmark/Streamly/Benchmark/Prelude/*.hs@@ -94,8 +97,7 @@     bin/mk-tags.sh     configure     configure.ac-    docs/*.hs-    docs/streamly-docs.cabal+    src/doctest/*.hs     targets/streamly-targets.cabal     targets/Targets.hs     test/test-runner/Main.hs@@ -108,32 +110,36 @@     src/assert.hs     src/config.h.in     src/inline.hs+    src/deprecation.h     test/Streamly/Test/Data/*.hs     test/Streamly/Test/Data/Array/CommonImports.hs     test/Streamly/Test/Data/Array/Common.hs     test/Streamly/Test/Data/Array/Generic.hs     test/Streamly/Test/Data/Array.hs     test/Streamly/Test/Data/MutArray.hs-    test/Streamly/Test/Data/Ring/Unboxed.hs+    test/Streamly/Test/Data/RingArray.hs     test/Streamly/Test/Data/Array/Stream.hs     test/Streamly/Test/Data/Parser.hs+    test/Streamly/Test/Data/Parser/*.hs     test/Streamly/Test/Data/ParserK.hs-    test/Streamly/Test/Data/Stream/Concurrent.hs+    test/Streamly/Test/Data/Stream/*.hs     test/Streamly/Test/FileSystem/Event.hs     test/Streamly/Test/FileSystem/Event/Common.hs     test/Streamly/Test/FileSystem/Event/Darwin.hs     test/Streamly/Test/FileSystem/Event/Windows.hs     test/Streamly/Test/FileSystem/Event/Linux.hs-    test/Streamly/Test/FileSystem/Handle.hs+    test/Streamly/Test/FileSystem/*.hs     test/Streamly/Test/Network/Socket.hs     test/Streamly/Test/Network/Inet/TCP.hs     test/Streamly/Test/Prelude.hs     test/Streamly/Test/Prelude/*.hs     test/Streamly/Test/Unicode/*.hs     test/Streamly/Test/Serialize/*.hs+    test/Streamly/Test/Data/Scanl/*.hs     test/Streamly/Test/Data/Fold/*.hs     test/lib/Streamly/Test/Common.hs     test/lib/Streamly/Test/Prelude/Common.hs+    test/lib/Streamly/Test/Parser/Common.hs     test/streamly-tests.cabal     test/version-bounds.hs     test/Streamly/Test/Unicode/ucd/NormalizationTest.txt@@ -156,31 +162,24 @@     README.md     benchmark/README.md     docs/*.md-    docs/Developer/Benchmarks.md-    docs/Developer/*.png+    docs/diagrams/module-diagram.hs+    docs/Developer/*.link     docs/Developer/*.md-    docs/Developer/*.rst     docs/Developer/*.png-    docs/Developer/*.md     docs/Developer/*.rst-    docs/Developer/*.link     docs/User/*.md-    docs/User/Tutorials/*.md-    docs/User/Tutorials/*.link-    docs/User/Tutorials/*.hs-    docs/User/HowTo/*.md-    docs/User/HowTo/*.link-    docs/User/HowTo/*.svg     docs/User/Explanatory/*.md     docs/User/Explanatory/streaming-pradigms.rst-    docs/User/Project/*.md-    docs/User/Project/Upgrading-0.8-to-0.9.md+    docs/User/HowTo/*.md+    docs/User/HowTo/*.svg     docs/User/Project/*.link-    docs/User/Project/ApiChangelogs/0.8.3.txt-    docs/User/Project/ApiChangelogs/0.8.3-0.9.0.txt-    docs/User/Project/ApiChangelogs/0.9.0-0.10.0.txt+    docs/User/Project/*.md+    docs/User/Project/ApiChangelogs/*.txt+    docs/User/Tutorials/*.md+    docs/User/Tutorials/*.link+    docs/User/Tutorials/*.svg+    docs/User/Tutorials/all-your-base.jpg     test/README.md-    docs/Developer/Tests.md  extra-tmp-files:     config.log@@ -207,8 +206,8 @@   manual: True   default: False -flag dev-  description: Development build+flag internal-dev+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -227,8 +226,8 @@   manual: True   default: False -flag use-unliftio-  description: Use unliftio-core instead of monad-control+flag internal-use-unliftio+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -237,8 +236,6 @@ -------------------------------------------------------------------------------  common compile-options-    default-language: Haskell2010-     if os(darwin)       cpp-options:    -DCABAL_OS_DARWIN @@ -248,7 +245,7 @@     if os(windows)       cpp-options:    -DCABAL_OS_WINDOWS -    if flag(dev)+    if flag(internal-dev)       cpp-options:    -DDEVBUILD      if flag(inspection)@@ -281,21 +278,38 @@     if flag(has-llvm)       ghc-options: -fllvm -    if flag(dev)+    if flag(internal-dev)       ghc-options:    -Wmissed-specialisations                       -Wall-missed-specialisations      if flag(limit-build-mem)         ghc-options: +RTS -M1000M -RTS -    if flag(use-unliftio)+    if flag(internal-use-unliftio)       cpp-options: -DUSE_UNLIFTIO  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.++    -- Don't enforce GHC2024 and GHC2021 but We can support the build with them.++    -- if impl(ghc >= 9.10)+    --   default-language: GHC2024++    -- if impl(ghc >= 9.2) && impl(ghc < 9.10)+    --   default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions:+        StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -307,26 +321,38 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         TupleSections         TypeApplications-        TypeFamilies         TypeOperators-        ViewPatterns -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,-        -- otherwise TypeFamilies will enable it again.-        NoMonoLocalBinds+    -- Not in GHC2024+    default-extensions:+        CApiFFI+        CPP+        MagicHash+        RecordWildCards +        -- TypeFamilies -- required by IsHashMap type class++        -- MonoLocalBinds, enabled by TypeFamilies and GHC2024, was+        -- once found to cause runtime performance regressions which+        -- does not seem to be the case anymore, but need more testing+        -- to confirm.  It is confirmed that it requires more memory+        -- for compilation at least in some cases (Data.Fold.Window+        -- benchmark on GHC-9.10.1 macOS).  Disabling this must come+        -- after TypeFamilies, otherwise TypeFamilies will enable it+        -- again.+        -- NoMonoLocalBinds+         -- UndecidableInstances -- Does not show any perf impact         -- UnboxedTuples        -- interferes with (#.) +    if impl(ghc >= 8.6)+      default-extensions: QuantifiedConstraints+ common optimization-options   if flag(opt)     ghc-options: -O2@@ -335,7 +361,7 @@                  -fmax-worker-args=16    -- For this to be effective it must come after the -O2 option-  if flag(dev) || flag(debug) || !flag(opt)+  if flag(internal-dev) || flag(debug) || !flag(opt)     ghc-options: -fno-ignore-asserts     cpp-options: -DDEBUG @@ -359,11 +385,9 @@ library     import: lib-options -    if impl(ghc >= 8.6)-      default-extensions: QuantifiedConstraints-     include-dirs:           src+        , src/doctest         , src/Streamly/Internal/Data/Stream      hs-source-dirs:    src@@ -385,6 +409,7 @@                      , Streamly.Internal.Data.Stream.Prelude                      , Streamly.Internal.Data.Unfold.Prelude                      , Streamly.Internal.Data.Fold.Prelude+                     , Streamly.Internal.Data.Scanl.Prelude                       -- streamly-unicode (depends on unicode-data)                      , Streamly.Internal.Unicode.Utf8@@ -398,6 +423,7 @@                      , Streamly.Data.Stream.MkType                      , Streamly.Data.Stream.Prelude                      , Streamly.Data.Fold.Prelude+                     , Streamly.Data.Scanl.Prelude                       -- Network/IO                      , Streamly.Network.Socket@@ -421,14 +447,14 @@                       , Streamly.Internal.Data.Stream.IsStream -    if !impl(ghcjs) && flag(dev)+    if !impl(ghcjs) && flag(internal-dev)         other-modules:                        Streamly.Internal.System.IOVec.Type                      , Streamly.Internal.System.IOVec                      , Streamly.Internal.FileSystem.FDIO                      , Streamly.Internal.FileSystem.FD -    if flag(dev)+    if flag(internal-dev)         exposed-modules: Streamly.Internal.Data.SmallArray         -- Exposed modules show up on hackage irrespective of the flag, so keep         -- it hidden.@@ -440,7 +466,7 @@      if os(darwin)           include-dirs:  src/Streamly/Internal-          c-sources: src/Streamly/Internal/FileSystem/Event/Darwin.m+          c-sources: src/Streamly/Internal/FileSystem/Event/Darwin.c           exposed-modules: Streamly.Internal.FileSystem.Event.Darwin      if os(linux)@@ -454,21 +480,22 @@          , Streamly.Internal.Data.Channel.Dispatcher          , Streamly.Internal.Data.Channel.Worker -         , Streamly.Internal.Data.Stream.Concurrent.Channel.Type-         , Streamly.Internal.Data.Stream.Concurrent.Channel.Dispatcher-         , Streamly.Internal.Data.Stream.Concurrent.Channel.Consumer-         , Streamly.Internal.Data.Stream.Concurrent.Channel.Append-         , Streamly.Internal.Data.Stream.Concurrent.Channel.Interleave-         , Streamly.Internal.Data.Stream.Concurrent.Channel.Operations-         , Streamly.Internal.Data.Stream.Concurrent.Channel+         , Streamly.Internal.Data.Stream.Channel.Type+         , Streamly.Internal.Data.Stream.Channel.Dispatcher+         , Streamly.Internal.Data.Stream.Channel.Consumer+         , Streamly.Internal.Data.Stream.Channel.Append+         , Streamly.Internal.Data.Stream.Channel.Interleave+         , Streamly.Internal.Data.Stream.Channel.Operations+         , Streamly.Internal.Data.Stream.Channel          , Streamly.Internal.Data.Stream.Concurrent          , Streamly.Internal.Data.Stream.Time          , Streamly.Internal.Data.Stream.Lifted -         , Streamly.Internal.Data.Fold.Async-         , Streamly.Internal.Data.Fold.Concurrent.Channel.Type-         , Streamly.Internal.Data.Fold.Concurrent.Channel+         , Streamly.Internal.Data.Fold.Time+         , Streamly.Internal.Data.Fold.Channel.Type+         , Streamly.Internal.Data.Fold.Channel          , Streamly.Internal.Data.Fold.Concurrent+         , Streamly.Internal.Data.Scanl.Concurrent           , Streamly.Internal.Data.Unfold.Exception          , Streamly.Internal.Data.Unfold.SVar@@ -504,39 +531,45 @@                     -- packages depending on the "ghc" package (packages                     -- depending on doctest is a common example) can                     -- depend on streamly.-                       base              >= 4.12  && < 4.20+                       base              >= 4.12  && < 4.22+                     , fusion-plugin-types >= 0.1 && < 0.2                      , containers        >= 0.6.0 && < 0.8                      , deepseq           >= 1.4.4 && < 1.6                      , exceptions        >= 0.8.0 && < 0.11                      , mtl               >= 2.2.2 && < 2.4                      , transformers      >= 0.5.5 && < 0.7-                     , template-haskell  >= 2.14  && < 2.22+                     , template-haskell  >= 2.14  && < 2.24                       -- The core streamly package-                     , streamly-core     == 0.2.2+                     , streamly-core     == 0.3.0 -                     , hashable          >= 1.3   && < 1.5+                     , hashable          >= 1.3   && < 1.6                      , unordered-containers >= 0.2 && < 0.3                      , heaps             >= 0.3     && < 0.5                      -- concurrency-                     , atomic-primops    >= 0.8   && < 0.9                      , lockfree-queue    >= 0.2.4 && < 0.3 -                     , unicode-data      >= 0.1 && < 0.5+                     , unicode-data      >= 0.1 && < 0.7                      -- Network-                     , network           >= 2.6   && < 3.2+                     , network           >= 2.6   && < 3.3 ++    if impl(ghc < 9.10)+      build-depends:   atomic-primops    >= 0.8   && < 0.9+    else+      build-depends:   atomic-primops    >= 0.8.8 && < 0.9+     if impl(ghc < 9.6)       build-depends:   transformers-base >= 0.4   && < 0.5 -    if flag(use-unliftio)+    if flag(internal-use-unliftio)       build-depends:   unliftio-core     >= 0.2 && < 0.3     else       build-depends:   monad-control     >= 1.0 && < 1.1 -    if flag(dev)+    if flag(internal-dev)       build-depends: primitive >= 0.5.4 && < 0.9      -- For FileSystem.Event module@@ -555,5 +588,5 @@      -- Array uses a Storable constraint in dev build making several inspection     -- tests fail-    if flag(dev) && flag(inspection)+    if flag(internal-dev) && flag(inspection)       build-depends: inspection-and-dev-flags-cannot-be-used-together
targets/Targets.hs view
@@ -1,85 +1,257 @@+{-# LANGUAGE CPP #-}+ module Targets     ( targets     ) where --- Special tags--- noTest--- noBench--- testDevOnly+-- Special tags:+-- *_grp groups+-- *_cmp comparison groups+-- noTest not available in tests+-- noBench not available in bench+-- testDevOnly dev only test targets :: [(String, [String])] targets =-    [ -- Base streams-      ("Data.Stream",-            [ "base_stream_grp"-            , "base_stream_cmp"+    [+      -------------------------------------------------------------------------+      -- Alphabetical order+      -------------------------------------------------------------------------++      ("Data.Array",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Array.Generic",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Array.Stream",+            [ "infinite_grp"+            , "serial_stream_grp"+            ]+      )+    , ("Data.Binary",+            [ "noBench"+            ]+      )+    , ("Data.Fold",+            [ "infinite_grp"+            , "fold_parser_grp"+            ]+      )+    , ("Data.Fold.Window",+            [ "infinite_grp"+            , "fold_parser_grp"+            ]+      )+    , ("Data.List",+            [ "list_grp"+            , "noBench"+            , "testDevOnly"+            ]+      )+    , ("Data.List.Base",+            [ "list_grp"+            , "noBench"+            ]+      )+    , ("Data.MutArray",+            [ "array_grp"+            , "array_cmp"+            ]+      )+    , ("Data.Parser",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            ]+      )+    , ("Data.ParserK",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"+            ]+      )+    , ("Data.ParserK.Chunked",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"             , "noTest"             ]       )-    , ("Data.StreamK",-            [ "base_stream_grp"-            , "base_stream_cmp"+    , ("Data.ParserK.Chunked.Generic",+            [ "infinite_grp"+            , "fold_parser_grp"+            , "parser_cmp"             , "noTest"             ]       )--{--    -- XXX Need devOnly flag support in BenchRunner-    , ("Data.Stream.ToStreamK",-            [ "noTest"-            , "devOnly"+    , ("Data.RingArray",+            [ "array_grp"             ]       )--}--    -- Streams-    , ("Data.Stream",-            [ "prelude_serial_grp"-            , "infinite_grp"-            , "serial_wserial_cmp"-            , "serial_async_cmp"+    , ("Data.Scanl",+            [ "infinite_grp"+            , "fold_parser_grp"             , "noTest"             ]       )-    , ("Data.Stream.StreamDK",-            [ "prelude_serial_grp"-            , "infinite_grp"+    , ("Data.Scanl.Window",+            [ "infinite_grp"+            , "fold_parser_grp"             , "noTest"             ]       )+    , ("Data.Serialize",+            [ "mut_bytearray_grp"+            ]+      )+    , ("Data.Serialize.Derive.TH",+            [ "mut_bytearray_grp"+            , "noBench"+            ]+      )+    , ("Data.Serialize.ENABLE_constructorTagAsString",+            [ "mut_bytearray_grp"+            , "noBench"+            ]+      )+    , ("Data.SmallArray",+            [ "noBench"+            , "testDevOnly"+            ]+      )+    , ("Data.Stream",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "serial_stream_cmp"+            , "serial_concurrent_cmp"+            ]+      )+    , ("Data.Stream.Adaptive",+            [ "concurrent_stream_grp"+            , "noTest"+            ]+      )+    -- XXX Concurrent and rate benchmarks take a long time with --long, perhaps+    -- need to use smaller stream sizes for these when using --long     , ("Data.Stream.Concurrent",-            [ "prelude_concurrent_grp"-            , "infinite_grp"-            , "concurrent_cmp"-            , "serial_async_cmp"+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "serial_concurrent_cmp"             ]       )     , ("Data.Stream.ConcurrentEager",-            [ "prelude_concurrent_grp"-            , "infinite_grp"-            , "concurrent_cmp"+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"             , "noTest"             ]       )+    , ("Data.Stream.ConcurrentInterleaved",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"+            , "noTest"+            ]+      )     , ("Data.Stream.ConcurrentOrdered",-            [ "prelude_concurrent_grp"-            , "infinite_grp"-            , "concurrent_cmp"+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "concurrent_stream_cmp"             , "noTest"             ]       )-    , ("Data.Stream.ConcurrentInterleaved",-            [ "prelude_concurrent_grp"-            , "infinite_grp"-            , "concurrent_cmp"+    , ("Data.Stream.ConcurrentThreadHeavy",+            [ "concurrent_stream_grp"             , "noTest"             ]       )-    , ("Data.Array.Stream",-            [ "prelude_serial_grp"-            , "infinite_grp"+    , ("Data.Stream.Rate",+            [ "infinite_grp"+            , "concurrent_stream_grp"+            , "testDevOnly"             ]       )+    , ("Data.StreamK",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "serial_stream_cmp"+            , "noTest"+            ]+      )+{-+    -- XXX Need devOnly flag support in BenchRunner+    , ("Data.StreamK.FromStream",+            [ "infinite_grp"+            , "serial_stream_grp"+            , "noTest"+            , "devOnly"+            ]+      )+-}+    , ("Data.Unbox",+            [ "noTest"+            ]+      )+    , ("Data.Unbox.Derive.Generic",+            [ "noBench"+            ]+      )+    , ("Data.Unbox.Derive.TH",+            []+      )+    , ("Data.Unbox.TH",+            [ "noBench"+            ]+      )+    , ("Data.Unfold",+            [ "infinite_grp"+            , "serial_stream_grp"+            ]+      )+    , ("FileSystem.Event",+            [ "noBench"+            ]+      )+#if defined(darwin_HOST_OS)+    , ("FileSystem.Event.Darwin",+            [ "noBench"+            ]+      )+#endif+#if defined(linux_HOST_OS)+    , ("FileSystem.Event.Linux",+            [ "noBench"+            , "testDevOnly"+            ]+      )+#endif+#if defined(mingw32_HOST_OS)+    , ("FileSystem.Event.Windows",+            [ "noBench"+            ]+      )+#endif+    , ("FileSystem.Handle", [])+    , ("FileSystem.DirIO", [])+    , ("Network.Inet.TCP", ["noBench"])+    , ("Network.Socket", ["noBench"])+    , ("Unicode.Char", ["testDevOnly"])+    , ("Unicode.Parser", [])+    , ("Unicode.Stream", [])+    , ("Unicode.Utf8", ["noTest"])+    , ("version-bounds", ["noBench"])++    ---- DEPRECATED ----++    -- test only, no benchmarks+    -- , ("Prelude", ["prelude_other_grp", "noBench"])+    -- , ("Prelude.Fold", ["prelude_other_grp", "noBench"])     -- Enabled only when use-prelude flag is set     -- , ("Prelude.Serial",     --         [ "prelude_serial_grp"@@ -153,61 +325,4 @@     --         , "noTest"     --         ]     --   )--    -- Arrays-    , ("Data.Array.Generic",-            [ "array_grp"-            , "array_cmp"-            ]-      )-    , ("Data.Array",-            [ "array_grp"-            , "array_cmp"-            , "pinned_array_cmp"-            ]-      )-    , ("Data.MutArray",-            [ "array_grp"-            , "array_cmp"-            ]-      )--    -- Ring-    , ("Data.Ring.Unboxed", [])--    -- Parsers-    , ("Data.ParserK",-            [ "base_parser_grp"-            , "base_parser_cmp"-            , "infinite_grp"-            , "noTest"-            ]-      )-    , ("Data.Fold", [ "parser_grp", "infinite_grp" ])-    , ("Data.Fold.Window", [ "parser_grp", "infinite_grp" ])-    , ("Data.Parser", [ "parser_grp", "infinite_grp" ])--    , ("Data.Unbox", ["noTest"])-    , ("Data.Unbox.TH", ["noBench"])-    , ("Data.Unbox.Derive.Generic", ["noBench"])-    , ("Data.Unbox.Derive.TH", [])-    , ("Data.Serialize", [])-    , ("Data.Serialize.Derive.TH", ["noBench"])-    , ("Data.Serialize.ENABLE_constructorTagAsString", ["noBench"])-    , ("Data.Unfold", ["infinite_grp"])-    , ("FileSystem.Handle", [])-    , ("Unicode.Stream", [])-    , ("Unicode.Utf8", ["noTest"])-    , ("Unicode.Char", ["testDevOnly"])--    -- test only, no benchmarks-    -- , ("Prelude", ["prelude_other_grp", "noBench"])-    -- , ("Prelude.Fold", ["prelude_other_grp", "noBench"])-    , ("FileSystem.Event", ["noBench"])-    , ("Network.Socket", ["noBench"])-    , ("Network.Inet.TCP", ["noBench"])-    , ("version-bounds", ["noBench"])--    , ("Data.List", ["list_grp", "noBench", "testDevOnly"])-    , ("Data.List.Base", ["list_grp", "noBench"])     ]
test/Streamly/Test/Data/Array.hs view
@@ -11,12 +11,15 @@ import Data.Char (isLower) import Data.List (sort) import Data.Proxy (Proxy(..))-import Data.Word(Word8)+import Data.Word(Word8, Word16) import Foreign.Storable (peek)-import GHC.Ptr (plusPtr)+import Foreign.ForeignPtr (newForeignPtr_, withForeignPtr)+import GHC.Ptr (plusPtr, Ptr(..)) import Streamly.Internal.Data.MutByteArray (Unbox, sizeOf) import Streamly.Internal.Data.MutArray (MutArray) import Test.QuickCheck (chooseInt, listOf)+import System.Mem (performMajorGC)+import Streamly.Test.Common (performGCSweep)  import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.MutArray as MA@@ -35,7 +38,7 @@  testFoldUnfold :: Property testFoldUnfold =-    genericTestFromTo (const (S.fold A.write)) (S.unfold A.reader) (==)+    genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==)  testFromList :: Property testFromList =@@ -52,8 +55,8 @@ unsafeWriteIndex :: [Int] -> Int -> Int -> IO Bool unsafeWriteIndex xs i x = do     arr <- MA.fromList xs-    MA.putIndexUnsafe i arr x-    x1 <- MA.getIndexUnsafe i arr+    MA.unsafePutIndex i arr x+    x1 <- MA.unsafeGetIndex i arr     return $ x1 == x  lastN :: Int -> [a] -> [a]@@ -67,63 +70,63 @@                 monadicIO $ do                     xs <- run                         $ fmap A.toList-                        $ S.fold (A.writeLastN n)+                        $ S.fold (A.createOfLast n)                         $ S.fromList list                     assert (xs == lastN n list)  testLastN_LN :: Int -> Int -> IO Bool testLastN_LN len n = do     let list = [1..len]-    l1 <- fmap A.toList $ S.fold (A.writeLastN n) $ S.fromList list+    l1 <- fmap A.toList $ S.fold (A.createOfLast n) $ S.fromList list     let l2 = lastN n list     return $ l1 == l2  testStrip :: IO Bool testStrip = do     dt <- MA.fromList "abcDEFgeh"-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == "DEF"  testStripLeft :: IO Bool testStripLeft = do     dt <- MA.fromList "abcDEF"-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == "DEF"  testStripRight :: IO Bool testStripRight = do     dt <- MA.fromList "DEFgeh"-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == "DEF"  testStripZero :: IO Bool testStripZero = do     dt <- MA.fromList "DEF"-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == "DEF"  testStripEmpty :: IO Bool testStripEmpty = do     dt <- MA.fromList "abc"-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == ""  testStripNull :: IO Bool testStripNull = do     dt <- MA.fromList ""-    dt' <- MA.strip isLower dt+    dt' <- MA.dropAround isLower dt     x <- MA.toList dt'     return $ x == ""  unsafeSlice :: Int -> Int -> [Int] -> Bool unsafeSlice i n list =     let lst = take n $ drop i list-        arr = A.toList $ A.getSliceUnsafe i n $ A.fromList list+        arr = A.toList $ A.unsafeSliceOffLen i n $ A.fromList list      in arr == lst  testBubbleWith :: Bool -> Property@@ -149,7 +152,7 @@                     else MA.bubble (flip compare) arr                     return arr                 )-                (MA.pinnedNew $ length ls)+                (MA.emptyOf' $ length ls)  testBubbleAsc ::  Property testBubbleAsc = testBubbleWith True@@ -159,19 +162,19 @@  testByteLengthWithMA :: forall a. Unbox a => a -> IO () testByteLengthWithMA _ = do-     arrA <- MA.pinnedNew 100 :: IO (MutArray a)-     let arrW8 = MA.castUnsafe arrA :: MutArray Word8+     arrA <- MA.emptyOf' 100 :: IO (MutArray a)+     let arrW8 = MA.unsafeCast arrA :: MutArray Word8      MA.byteLength arrA `shouldBe` MA.length arrW8  testBreakOn :: [Word8] -> Word8 -> [Word8] -> Maybe [Word8] -> IO () testBreakOn inp sep bef aft = do-    (bef_, aft_) <- A.breakOn sep (A.fromList inp)+    (bef_, aft_) <- A.breakEndByWord8_ sep (A.fromList inp)     bef_ `shouldBe` A.fromList bef     aft_ `shouldBe` fmap A.fromList aft  testWrite :: [Char] -> IO () testWrite inp = do-    arr <- S.fold A.write (S.fromList inp)+    arr <- S.fold A.create (S.fromList inp)     A.toList arr `shouldBe` inp  testFromToList :: [Char] -> IO ()@@ -180,12 +183,12 @@ testUnsafeIndxedFromList :: [Char] -> IO () testUnsafeIndxedFromList inp =     let arr = A.fromList inp-     in fmap (`A.getIndexUnsafe` arr) [0 .. (length inp - 1)] `shouldBe` inp+     in fmap (`A.unsafeGetIndex` arr) [0 .. (length inp - 1)] `shouldBe` inp -testAsPtrUnsafeMA :: IO ()-testAsPtrUnsafeMA = do-    arr <- MA.fromList ([0 .. 99] :: [Int])-    MA.unsafePinnedAsPtr arr (getList (0 :: Int)) `shouldReturn` [0 .. 99]+getIntList :: Ptr Int -> Int -> IO [Int]+getIntList ptr byteLen = do+    performMajorGC+    getList ptr (ptr `plusPtr` byteLen)      where @@ -193,13 +196,70 @@      -- We need to be careful here. We assume Unboxed and Storable are compatible     -- with each other. For Int, they are compatible.-    getList i _-        | i >= 100 = return []-    getList i p = do+    getList p limitP+        | p >= limitP = return []+    getList p limitP = do         val <- peek p-        rest <- getList (i + 1) (p `plusPtr` sizeOfInt)+        rest <- getList (p `plusPtr` sizeOfInt) limitP         return $ val : rest +testAsPtrUnsafeMA :: IO ()+testAsPtrUnsafeMA = do+    arr <- MA.fromList ([0 .. 99] :: [Int])+    arr1 <- MA.pin arr+    MA.unsafeAsPtr arr1 getIntList `shouldReturn` [0 .. 99]++testUnsafePinnedAsPtr :: IO ()+testUnsafePinnedAsPtr = do+    arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int])+    let arr1 = A.unsafeFreeze arr+    A.unsafePinnedAsPtr arr1 getIntList `shouldReturn` [10 .. 59]++testUnsafeAsForeignPtr :: IO ()+testUnsafeAsForeignPtr = do+    arr <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Int])+    let arr1 = A.unsafeFreeze arr+    A.unsafeAsForeignPtr arr1 getIntList1 `shouldReturn` [10 .. 59]+    where+    getIntList1 fp blen = withForeignPtr fp $ \p -> getIntList p blen++testForeignPtrConversionId :: IO ()+testForeignPtrConversionId = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafeAsForeignPtr arr $ \a b -> do+        res <- A.unsafeFromForeignPtr a b+        performGCSweep 4 100000+        res `shouldBe` arr+++testUnsafeFromForeignPtr :: IO ()+testUnsafeFromForeignPtr = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr arr $ \ptr len -> do+        fptr <- newForeignPtr_ ptr+        performMajorGC+        A.unsafeFromForeignPtr fptr len `shouldReturn` arr++testFromCString# :: IO ()+testFromCString# = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word8])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do+        arr1 <- A.fromCString# addr#+        performGCSweep 4 100000+        arr1 `shouldBe` arr++testFromW16CString# :: IO ()+testFromW16CString# = do+    arr0 <- MA.unsafeSliceOffLen 10 50 <$> MA.fromList ([0 .. 99] :: [Word16])+    let arr = A.unsafeFreeze arr0+    A.unsafePinnedAsPtr (arr <> A.fromList [0]) $ \(Ptr addr#) _ -> do+        arr1 <- A.fromW16CString# addr#+        performGCSweep 4 100000+        arr1 `shouldBe` arr+ reallocMA :: Property reallocMA =     let len = 10000@@ -207,7 +267,7 @@     in forAll (vectorOf len (arbitrary :: Gen Char)) $ \vec ->            forAll (chooseInt (bSize - 2000, bSize + 2000)) $ \newBLen -> do                arr <- MA.fromList vec-               arr1 <- MA.realloc newBLen arr+               arr1 <- MA.reallocBytes newBLen arr                lst <- MA.toList arr                lst1 <- MA.toList arr1                lst `shouldBe` lst1@@ -230,6 +290,13 @@             prop "fromList" testFromList             prop "foldMany with writeNUnsafe concats to original"                 (foldManyWith (\n -> Fold.take n (A.unsafeCreateOf n)))+        describe "AsPtr" $ do+            it "testUnsafePinnedAsPtr" testUnsafePinnedAsPtr+            it "testUnsafeAsForeignPtr" testUnsafeAsForeignPtr+            it "testForeignPtrConversionId" testForeignPtrConversionId+            it "testUnsafeFromForeignPtr" testUnsafeFromForeignPtr+            it "testFromCString#" testFromCString#+            it "testFromW16CString#" testFromW16CString#         describe "unsafeSlice" $ do             it "partial" $ unsafeSlice 2 4 [1..10]             it "none" $ unsafeSlice 10 0 [1..10]@@ -239,12 +306,12 @@             it "middle" (unsafeWriteIndex [1..10] 5 0 `shouldReturn` True)             it "last" (unsafeWriteIndex [1..10] 9 0 `shouldReturn` True)         describe "Fold" $ do-            prop "writeLastN : 0 <= n <= len" testLastN-            describe "writeLastN boundary conditions" $ do-                it "writeLastN -1" (testLastN_LN 10 (-1) `shouldReturn` True)-                it "writeLastN 0" (testLastN_LN 10 0 `shouldReturn` True)-                it "writeLastN length" (testLastN_LN 10 10 `shouldReturn` True)-                it "writeLastN (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)+            prop "createOfLast : 0 <= n <= len" testLastN+            describe "createOfLast boundary conditions" $ do+                it "createOfLast -1" (testLastN_LN 10 (-1) `shouldReturn` True)+                it "createOfLast 0" (testLastN_LN 10 0 `shouldReturn` True)+                it "createOfLast length" (testLastN_LN 10 10 `shouldReturn` True)+                it "createOfLast (length + 1)" (testLastN_LN 10 11 `shouldReturn` True)         describe "Strip" $ do             it "strip" (testStrip `shouldReturn` True)             it "stripLeft" (testStripLeft `shouldReturn` True)@@ -267,7 +334,7 @@         describe "toList . fromList" $ do             it "testFromToList abc" (testFromToList "abc")             it "testFromToList \\22407" (testFromToList "\22407")-        describe "getIndexUnsafe . fromList" $ do+        describe "unsafeGetIndex . fromList" $ do             it "testUnsafeIndxedFromList abc" (testUnsafeIndxedFromList "abc")             it "testUnsafeIndxedFromList \\22407"                    (testUnsafeIndxedFromList "\22407")
test/Streamly/Test/Data/Array/Common.hs view
@@ -23,7 +23,7 @@                 assert (A.length arr == len)  testLength :: Property-testLength = genericTestFrom (S.fold . A.writeN)+testLength = genericTestFrom (S.fold . A.createOf)  testLengthFromStreamN :: Property testLengthFromStreamN = genericTestFrom A.fromStreamN@@ -44,16 +44,16 @@  testFoldNUnfold :: Property testFoldNUnfold =-    genericTestFromTo (S.fold . A.writeN) (S.unfold A.reader) (==)+    genericTestFromTo (S.fold . A.createOf) (S.unfold A.reader) (==)  testFoldNToStream :: Property testFoldNToStream =-    genericTestFromTo (S.fold . A.writeN) A.read (==)+    genericTestFromTo (S.fold . A.createOf) A.read (==)  testFoldNToStreamRev :: Property testFoldNToStreamRev =     genericTestFromTo-        (S.fold . A.writeN)+        (S.fold . A.createOf)         A.readRev         (\xs list -> xs == reverse list) @@ -81,7 +81,7 @@             monadicIO $ do                 xs <- run                     $ S.fold Fold.toList-                    $ S.unfoldMany A.reader+                    $ S.unfoldEach A.reader                     $ S.foldMany (f 240)                     $ S.fromList list                 assert (xs == list)@@ -98,4 +98,4 @@         prop "toStream . fromStreamN === id" testFromStreamNToStream         prop "fromListN" testFromListN         prop "foldMany with writeN concats to original"-            (foldManyWith A.writeN)+            (foldManyWith A.createOf)
test/Streamly/Test/Data/Array/Generic.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Test.Data.Array.Generic@@ -27,7 +26,7 @@  testFoldUnfold :: Property testFoldUnfold =-    genericTestFromTo (const (S.fold A.write)) (S.unfold A.reader) (==)+    genericTestFromTo (const (S.fold A.create)) (S.unfold A.reader) (==)  testFromList :: Property testFromList =
test/Streamly/Test/Data/Array/Stream.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  module Main (main) where @@ -10,7 +9,6 @@ import Test.QuickCheck.Monadic (assert, monadicIO, run)  import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Array.Stream as ArrayStream import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.Stream as Stream@@ -57,10 +55,10 @@                     let input =                             Stream.toStreamK                                 $ chunksOf-                                clen (Array.writeN clen) (Stream.fromList ls)+                                clen (Array.createOf clen) (Stream.fromList ls)                         parser = Parser.fromFold (Fold.take tlen Fold.toList)-                     in run $ ArrayStream.parseBreak parser input-                ls2 <- run $ Stream.fold Fold.toList (ArrayStream.concat $ Stream.fromStreamK str)+                     in run $ Array.parseBreak (Array.toParserK parser) input+                ls2 <- run $ Stream.fold Fold.toList (Array.concat $ Stream.fromStreamK str)                 case ls1 of                     Right x -> listEquals (==) (x ++ ls2) ls                     Left _ -> assert False@@ -69,8 +67,8 @@ splitOnSuffix sep inp out = do     res <-         Stream.fold Fold.toList-            $ ArrayStream.splitOnSuffix sep-            $ chunksOf 2 (Array.writeN 2) $ Stream.fromList inp+            $ Array.compactEndByByte_ sep+            $ chunksOf 2 (Array.createOf 2) $ Stream.fromList inp     fmap Array.toList res `shouldBe` out  -------------------------------------------------------------------------------@@ -88,7 +86,7 @@     forAll (vectorOf 10000 (arbitrary :: Gen Word8))         $ \w8List -> do               let w8ArrList = Array.fromList . (: []) <$> w8List-              f2 <- Stream.fold Fold.toList $ ArrayStream.concat $ Stream.fromList w8ArrList+              f2 <- Stream.fold Fold.toList $ Array.concat $ Stream.fromList w8ArrList               w8List `shouldBe` f2
test/Streamly/Test/Data/Fold.hs view
@@ -596,9 +596,9 @@  demux :: Expectation demux =-    let table "SUM" = return Fold.sum-        table "PRODUCT" = return Fold.product-        table _ = return Fold.length+    let table "SUM" = return $ Just Fold.sum+        table "PRODUCT" = return $ Just Fold.product+        table _ = return $ Just Fold.length         input = Stream.fromList  (                 [ ("SUM", 1)                 , ("abc", 1)
test/Streamly/Test/Data/Fold/Window.hs view
@@ -1,9 +1,11 @@ module Streamly.Test.Data.Fold.Window (main) where  import Test.Hspec (hspec, describe, it, runIO)-import qualified Streamly.Internal.Data.Ring as Ring-import qualified Streamly.Internal.Data.Stream as S+import Streamly.Internal.Data.Scanl (Incr(..)) import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Stream as S  import Prelude hiding (sum, maximum, minimum) @@ -19,17 +21,20 @@                                 9007199254740992, 1, 1, 1, 9007199254740992]             testCase = take numElem $ cycle testCaseChunk             deviationLimit = 1+             testFunc f = do                 let c = S.fromList testCase-                a <- runIO $ S.fold (Ring.slidingWindow winSize f) c-                b <- runIO $ S.fold f $ S.drop (numElem - winSize)-                        $ fmap (, Nothing) c+                    f1 = Fold.fromScanl $ Scanl.incrScan winSize f+                    f2 = Fold.fromScanl f+                a <- runIO $ S.fold f1 c+                b <- runIO $ S.fold f2 $ S.drop (numElem - winSize)+                        $ fmap Insert c                 let c1 = a - b                 it ("should not deviate more than " ++ show deviationLimit)                     $ c1 >= -1 * deviationLimit && c1 <= deviationLimit -        describe "Sum" $ testFunc Fold.windowSum-        describe "mean" $ testFunc Fold.windowMean+        describe "Sum" $ testFunc Scanl.incrSum+        describe "mean" $ testFunc Scanl.incrMean      describe "Correctness" $ do         let winSize = 3@@ -40,28 +45,45 @@              testFunc tc f sI sW = do                 let c = S.fromList tc-                a <- runIO $ S.fold Fold.toList $ S.postscan f $ fmap (, Nothing) c-                b <- runIO $ S.fold Fold.toList $ S.postscan-                        (Ring.slidingWindow winSize f) c+                a <- runIO $ S.fold Fold.toList $ S.postscanl f $ fmap Insert c+                b <- runIO $ S.fold Fold.toList $ S.postscanl+                        (Scanl.incrScan winSize f) c                 it "Infinite" $ a  == sI                 it ("Finite " ++ show winSize) $ b == sW              testFunc2 tc expec f = do                 let c = S.fromList tc-                a <- runIO $ S.fold (f winSize) c+                a <- runIO $ S.toList $ S.postscanl (f winSize) c+                runIO $ print a                 it (show tc) $ a == expec +        describe "toList" $ do+            testFunc2 testCase1+                [[1.0],[1.0,4.0],[1.0,4.0,3.0],[4.0,3.0,2.1],[3.0,2.1,-5.1]+                ,[2.1,-5.1,-2.0],[-5.1,-2.0,7.0],[-2.0,7.0,3.0],[7.0,3.0,-2.5]+                ]+                (RingArray.scanFoldRingsBy Fold.toList)         describe "minimum" $ do-            testFunc2 testCase1 (Just (-2.5)) Fold.windowMinimum+            testFunc2 testCase1+                [Just 1.0,Just 1.0,Just 1.0,Just 2.1,Just (-5.1),Just (-5.1)+                ,Just (-5.1),Just (-2.0),Just (-2.5)]+                (RingArray.scanFoldRingsBy Fold.minimum)         describe "maximum" $ do-            testFunc2 testCase1 (Just 7.0) Fold.windowMaximum+            testFunc2 testCase1+                [Just 1.0,Just 4.0,Just 4.0,Just 4.0,Just 3.0,Just 2.1+                ,Just 7.0,Just 7.0,Just 7.0]+                (RingArray.scanFoldRingsBy Fold.maximum)         describe "range" $ do-            testFunc2 testCase1 (Just (-2.5, 7.0)) Fold.windowRange+            testFunc2 testCase1+                [Just (1.0,1.0),Just (1.0,4.0),Just (1.0,4.0),Just (2.1,4.0)+                ,Just (-5.1,3.0),Just (-5.1,2.1),Just (-5.1,7.0)+                ,Just (-2.0,7.0),Just (-2.5,7.0)]+                (RingArray.scanFoldRingsBy Fold.range)         describe "sum" $ do             let scanInf = [1, 2, 3, 4, 5, 12] :: [Double]                 scanWin = [1, 2, 3, 3, 3, 9] :: [Double]-            testFunc testCase2 Fold.windowSum scanInf scanWin+            testFunc testCase2 Scanl.incrSum scanInf scanWin         describe "mean" $ do             let scanInf = [1, 1, 1, 1, 1, 2] :: [Double]                 scanWin = [1, 1, 1, 1, 1, 3] :: [Double]-            testFunc testCase2 Fold.windowMean scanInf scanWin+            testFunc testCase2 Scanl.incrMean scanInf scanWin
test/Streamly/Test/Data/MutArray.hs view
@@ -20,7 +20,7 @@ import Test.QuickCheck (forAll, Property) import Test.QuickCheck.Monadic (monadicIO, assert) #if MIN_VERSION_base(4,15,0)-import GHC.RTS.Flags (IoSubSystem(..))+import GHC.IO.SubSystem (IoSubSystem (..)) #endif  import qualified Streamly.Internal.Data.MutArray as MArray@@ -41,8 +41,9 @@         where          action ls = do+            arr0 <- MArray.emptyOf' 0             x <- Stream.fold-                    (MArray.writeAppend (MArray.pinnedNew 0))+                    (MArray.append2 arr0)                     (Stream.fromList (ls::[Int]))             lst <- MArray.toList x             assert (ls == lst)
test/Streamly/Test/Data/Parser.hs view
@@ -1,1379 +1,470 @@--- XXX We are using head/tail at one place-#if __GLASGOW_HASKELL__ >= 908-{-# OPTIONS_GHC -Wno-x-partial #-}-#endif-module Main (main) where--import Control.Applicative ((<|>))-import Control.Exception (displayException)-import Data.Foldable (for_)-import Data.Word (Word8, Word32, Word64)-import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)-import Test.Hspec (Spec, hspec, describe)-import Test.Hspec.QuickCheck-import Test.QuickCheck-       (arbitrary, forAll, elements, Property, property, listOf,-        vectorOf, Gen, (.&&.))-import Test.QuickCheck.Monadic (monadicIO, assert, run)--import Prelude hiding (sequence)--import qualified Control.Monad.Fail as Fail-import qualified Data.List as List-import qualified Prelude-import qualified Streamly.Data.Stream as S-import qualified Streamly.Internal.Data.Array as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as P-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Test.Hspec as H--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)-import Control.Monad.Identity (Identity(runIdentity, Identity))-import Streamly.Internal.Data.Parser (ParseError(..))--#else--import System.Random (Random(random))-import Test.QuickCheck.Gen (Gen(MkGen))---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)--#endif--maxTestCount :: Int-maxTestCount = 100--min_value :: Int-min_value = 0--mid_value :: Int-mid_value = 5000--max_value :: Int-max_value = 10000--max_length :: Int-max_length = 1000---- Accumulator Tests--fromFold :: Property-fromFold =-    forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->-        monadicIO $ do-        s1 <- S.parse (P.fromFold FL.sum) (S.fromList ls)-        o2 <- S.fold FL.sum (S.fromList ls)-        return $-            case s1 of-                Right o1 -> o1 == o2-                Left _ -> False--fromPure :: Property-fromPure =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case runIdentity $ S.parse (P.fromPure x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--fromEffect :: Property-fromEffect =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case runIdentity $ S.parse (P.fromEffect $ return x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--die :: Property-die =-    property $-    case runIdentity $ S.parse (P.die "die test") (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True--dieM :: Property-dieM =-    property $-    case runIdentity $ S.parse (P.dieM (Identity "die test")) (S.fromList [0 :: Int]) of-        Right _ -> False-        Left _ -> True--parserFail :: Property-parserFail =-    property $-        case runIdentity $ S.parse (Fail.fail err) (S.fromList [0 :: Int]) of-            Right _ -> False-            Left (ParseError e) -> err == e-    where-    err = "Testing MonadFail.fail."---- Element Parser Tests--peekPass :: Property-peekPass =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parse P.peek (S.fromList ls) of-                Right head_value -> case ls of-                    head_ls : _ -> head_value == head_ls-                    _ -> False-                Left _ -> False--peekFail :: Property-peekFail =-    property (case runIdentity $ S.parse P.peek (S.fromList []) of-        Right _ -> False-        Left _ -> True)--eofPass :: Property-eofPass =-    property (case runIdentity $ S.parse P.eof (S.fromList []) of-        Right _ -> True-        Left _ -> False)--eofFail :: Property-eofFail =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parse P.eof (S.fromList ls) of-                Right _ -> False-                Left _ -> True--satisfyPass :: Property-satisfyPass =-    forAll (chooseInt (mid_value, max_value)) $ \first_element ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->-            let-                ls = first_element : ls_tail-                predicate = (>= mid_value)-            in-                case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of-                    Right r -> r == first_element-                    Left _ -> False--satisfy :: Property-satisfy =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        case runIdentity $ S.parse (P.satisfy predicate) (S.fromList ls) of-            Right r -> case ls of-                [] -> False-                (x : _) -> predicate x && (r == x)-            Left _ -> case ls of-                [] -> True-                (x : _) -> not $ predicate x-        where-            predicate = (>= mid_value)--onePass :: Property-onePass =-    forAll (chooseInt (1, max_value)) $ \int ->-        property (case runIdentity $ S.parse P.one (S.fromList [int]) of-            Right i -> i  == int-            Left _ -> False)--one :: Property-one =-    property $-        case runIdentity $ S.parse P.one (S.fromList []) of-            Left _ -> True-            Right _ -> False---- Sequence Parsers Tests-takeBetweenPass :: Property-takeBetweenPass =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (m, max_value)) $ \n ->-            forAll (chooseInt (m, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value)))-                    $ \ls ->-                        case runIdentity $ S.parse (P.takeBetween m n FL.toList)-                                (S.fromList ls) of-                            Right parsed_list ->-                                let lpl = Prelude.length parsed_list-                                in checkListEqual parsed_list-                                    $ Prelude.take lpl ls-                            Left _ -> property False--_takeBetween :: Property-_takeBetween =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (min_value, max_value)) $ \n ->-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                go m n ls--    where--    go m n ls =-        let inputLen = Prelude.length ls-         in do-            let p = P.takeBetween m n FL.toList-            case runIdentity $ S.parse p (S.fromList ls) of-                Right xs ->-                    let parsedLen = Prelude.length xs-                    in if inputLen >= m && parsedLen >= m && parsedLen <= n-                        then checkListEqual xs $ Prelude.take parsedLen ls-                        else property False-                Left _ ->-                    property ((m >= 0 && n >= 0 && m > n) || inputLen < m)--take :: Property-take =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parse (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)-                Left _ -> property False--takeEQPass :: Property-takeEQPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length-                        (chooseInt (min_value, max_value))) $ \ls ->-                case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        checkListEqual parsed_list (Prelude.take n ls)-                    Left _ -> property False--takeEQ :: Property-takeEQ =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case runIdentity $ S.parse (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if n <= list_length-                        then checkListEqual parsed_list (Prelude.take n ls)-                        else property False-                    Left _ -> property (n > list_length)--takeGEPass :: Property-takeGEPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value)))-                $ \ls ->-                    case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of-                        Right parsed_list -> checkListEqual parsed_list ls-                        Left _ -> property False--takeGE :: Property-takeGE =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case runIdentity $ S.parse (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if n <= list_length-                        then checkListEqual parsed_list ls-                        else property False-                    Left _ -> property (n > list_length)--nLessThanEqual0 ::-       (  Int-       -> FL.Fold Identity Int [Int]-       -> P.Parser Int Identity [Int]-       )-    -> (Int -> [Int] -> [Int])-    -> Property-nLessThanEqual0 tk ltk =-    forAll (elements [0, (-1)]) $ \n ->-        forAll (listOf arbitrary) $ \ls ->-            case runIdentity $ S.parse (tk n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (ltk n ls)-                Left _ -> property False--takeProperties :: Spec-takeProperties =-    describe "take combinators when n <= 0/" $ do-        prop "takeEQ n FL.toList = []" $-            nLessThanEqual0 P.takeEQ (\_ -> const [])-        prop "takeGE n FL.toList xs = xs" $-            nLessThanEqual0 P.takeGE (\_ -> id)---- XXX lookAhead can't deal with EOF which in this case means when--- n==list_length, this test will fail. So excluding that case for now.-lookAheadPass :: Property-lookAheadPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (chooseInt (n+1, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                    case runIdentity $ S.parse parseTwice (S.fromList ls) of-                        Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                        Left _ -> property $ False---- lookAheadFail :: Property--- lookAheadFail =---     forAll (chooseInt (min_value + 1, max_value)) $ \n ->---         let---             takeWithoutConsume = P.lookAhead $ P.take n FL.toList---             parseTwice = do---                 parsed_list_1 <- takeWithoutConsume---                 parsed_list_2 <- takeWithoutConsume---                 return (parsed_list_1, parsed_list_2)---         in---             forAll (chooseInt (min_value, n - 1)) $ \list_length ->---                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->---                     case S.parse parseTwice (S.fromList ls) of---                         Right _ -> False---                         Left _ -> True--lookAhead :: Property-lookAhead =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                case runIdentity $ S.parse parseTwice (S.fromList ls) of-                    Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                    Left _ -> property ((list_length < n) || (list_length == n && n == 0))-                        where-                            list_length = Prelude.length ls--takeEndBy_ :: Property-takeEndBy_ =-    forAll (listOf (chooseInt (min_value, max_value )))  $ \ls ->-        case runIdentity $ S.parse (P.takeEndBy_ predicate prsr) (S.fromList ls) of-            Right parsed_list ->-                checkListEqual parsed_list (tkwhl ls)-            Left _ -> property False-        where-            predicate = (>= 100)-            prsr = P.many (P.satisfy (const True)) FL.toList-            tkwhl ls = Prelude.takeWhile (not . predicate) ls--takeEndByOrMax_ :: Property-takeEndByOrMax_ =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (0, 1))) $ \ls ->-            case runIdentity $ S.parse (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))-                Left _ -> property False-            where-                predicate = (== 1)--takeStartBy :: Property-takeStartBy =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        let ls1 = 1:ls-        in-            case runIdentity $ S.parse parser (S.fromList ls1) of-                Right parsed_list ->-                  if not $ Prelude.null ls1-                  then-                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)-                    in checkListEqual parsed_list $-                      if predicate (head ls1)-                      then head ls1 : tls-                      else Prelude.takeWhile (not . predicate) ls1-                  else property $ Prelude.null parsed_list-                Left _ -> property False-            where-                predicate = odd-                parser = P.takeStartBy predicate FL.toList--takeWhile :: Property-takeWhile =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case runIdentity $ S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of-            Right parsed_list ->-                checkListEqual parsed_list (Prelude.takeWhile predicate ls)-            Left _ -> property False-        where-            predicate = (== 0)--takeP :: Property-takeP =-    forAll-        ((,) <$> chooseInt (min_value, max_value)-             <*> listOf (chooseInt (0, 1)))-        $ \(takeNum, ls) ->-              case runIdentity $ S.parse-                       (P.takeP takeNum (P.fromFold FL.toList))-                       (S.fromList ls) of-                  Right parsed_list ->-                      checkListEqual parsed_list (Prelude.take takeNum ls)-                  Left _ -> property False--takeWhile1 :: Property-takeWhile1 =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case runIdentity $ S.parse (P.takeWhile1 predicate  FL.toList) (S.fromList ls) of-            Right parsed_list -> case ls of-                [] -> property False-                (x : _) ->-                    if predicate x-                    then-                        checkListEqual parsed_list-                           $ Prelude.takeWhile predicate ls-                    else-                        property False-            Left _ -> case ls of-                [] -> property True-                (x : _) -> property (not $ predicate x)-        where-            predicate = (== 0)--takeWhileP :: Property-takeWhileP =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        forAll (chooseInt (min_value, max_value)) $ \n ->-            let-                predicate = (== 1)--                prsr =-                    P.takeWhileP predicate-                        $ P.fromFold (FL.take n FL.toList)--                takeWhileTillLen maxLen prd list =-                    Prelude.take maxLen $ Prelude.takeWhile prd list-            in-                case runIdentity $ S.parse prsr (S.fromList ls) of-                    Right parsed_list ->-                        checkListEqual-                        parsed_list-                        (takeWhileTillLen n predicate ls)-                    Left _ -> property False--{--choice :: Property-choice =-    forAll-        ((,,) <$> chooseInt (min_value, max_value)-             <*> chooseInt (min_value, max_value)-             <*> listOf (chooseInt (0, 1)))-        $ \(i, j, ls) ->-              case S.parse (P.choice [parser i, parser j]) (S.fromList ls) of-                  Right parsed_list ->-                      checkListEqual parsed_list $ take (min i j) ls-                  Left _ -> property False--    where--    parser i = P.fromFold (FL.take i FL.toList)--}--groupBy :: Property-groupBy =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case runIdentity $ S.parse parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF lst-        | null lst = []-        | otherwise = head $ List.groupBy cmp lst--groupByRolling :: Property-groupByRolling =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case runIdentity $ S.parse parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF Nothing ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF _ [] = []-    groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs-    groupByLF (Just y) (x:xs) =-        if cmp y x-        then x : groupByLF (Just x) xs-        else []--wordBy :: Property-wordBy =-    forAll (listOf (elements [' ', 's']))-        $ \ls ->-              case runIdentity $ S.parse parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (words' ls)-                  Left _ -> property False--    where--    predicate = (== ' ')-    parser = P.many (P.wordBy predicate FL.toList) FL.toList-    words' lst =-        let wrds = words lst-         in if wrds == [] && length lst > 0 then [""] else wrds--parseManyWordQuotedBy :: H.SpecWith ()-parseManyWordQuotedBy =-    describe "parseMany wordQuotedBy"-        $ for_ testCases-        $ \c@(kQ, isQ, input, expected) -> do-              let inpStrm = S.fromList input--                  esc = '\\'--                  spc ' ' = True-                  spc _ = False--                  tr _ _ = Nothing--                  parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList-              result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm-              H.it (showCase c) $ result `H.shouldBe` expected--    where--    showCase (kQ, _, input, expected) =-        show kQ ++ ", " ++ input ++ " -> " ++ show expected--    testCases =-        [ ( True-          , \x -> if x == '\'' then Just '\'' else Nothing-          , "The quick brown fox"-          , ["The", "quick", "brown", "fox"])-        , ( True-          , \x -> if x == '\'' then Just '\'' else Nothing-          , "The' quick brown' fox"-          , ["The' quick brown'", "fox"])-        , ( False-          , \x -> if x == '\'' then Just '\'' else Nothing-          , "The' quick brown' fox"-          , ["The quick brown", "fox"])-        , ( True-          , \x -> if x == '[' then Just ']' else Nothing-          , "The[ quick brown] fox"-          , ["The[ quick brown]", "fox"])-        , ( True-          , \x -> if x == '[' then Just ']' else Nothing-          , "The[ qui[ck] brown] \\ f[  ox]"-          , ["The[ qui[ck] brown]", " f[  ox]"])-        , ( False-          , \x -> if x == '[' then Just ']' else Nothing-          , "The[ qui[ck] brown] fox"-          , ["The qui[ck] brown", "fox"])-        ]--splitWith :: Property-splitWith =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        case runIdentity $ S.parse (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of-            Right (result_first, result_second) -> case ls of-                0 : 1 : _ -> (result_first == 0) && (result_second == 1)-                _ -> False-            Left _ -> case ls of-                0 : 1 : _ -> False-                _ -> True--splitWithFailLeft :: Property-splitWithFailLeft =-    property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailRight :: Property-splitWithFailRight =-    property (case runIdentity $ S.parse (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailBoth :: Property-splitWithFailBoth =-    property (case runIdentity $ S.parse (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)---- teeWithPass :: Property--- teeWithPass =---     forAll (chooseInt (min_value, max_value)) $ \n ->---         forAll (listOf (chooseInt (0, 1))) $ \ls ->---             let---                 prsr = P.fromFold $ FL.take n FL.toList---             in---                 case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of---                     Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2---                     Left _ -> property False---- teeWithFailLeft :: Property--- teeWithFailLeft =---     property (case S.parse (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- teeWithFailRight :: Property--- teeWithFailRight =---     property (case S.parse (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)---- teeWithFailBoth :: Property--- teeWithFailBoth =---     property (case S.parse (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)--{--deintercalate :: Property-deintercalate =-    forAll (listOf (chooseAny :: Gen Int)) $ \ls ->-        case runIdentity $ S.parse p (S.fromList ls) of-            Right evenOdd -> evenOdd == List.partition even ls-            Left _ -> False--        where-            p1 = P.takeWhile even FL.toList-            p2 = P.takeWhile odd FL.toList-            partition =-                FL.tee (fmap concat $ FL.catLefts FL.toList)-                       (fmap concat $ FL.catRights FL.toList)-            p = P.deintercalate p1 p2 partition--}---- shortestPass :: Property--- shortestPass =---     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->---         let---             half_mid_value = mid_value `Prelude.div` 2---             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList---             prsr_2 = P.takeWhile (<= mid_value) FL.toList---             prsr_shortest = P.shortest prsr_1 prsr_2---         in---             case S.parse prsr_shortest (S.fromList ls) of---                 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)---                 Left _ -> property False---- shortestPassLeft :: Property--- shortestPassLeft =---     property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)------ shortestPassRight :: Property--- shortestPassRight =---     property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)---- shortestFailBoth :: Property--- shortestFailBoth =---     property---         (case S.parse---                   (P.shortest (P.die "die") (P.die "die"))---                   (S.fromList [1 :: Int]) of---              Right _ -> False---              Left _ -> True)------ longestPass :: Property--- longestPass =---     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->---         let---             half_mid_value = mid_value `Prelude.div` 2---             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList---             prsr_2 = P.takeWhile (<= mid_value) FL.toList---             prsr_longest = P.longest prsr_1 prsr_2---         in---             case S.parse prsr_longest (S.fromList ls) of---                 Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls---                 Left _ -> False------ longestPassLeft :: Property--- longestPassLeft =---     property (case S.parse (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)------ longestPassRight :: Property--- longestPassRight =---     property (case S.parse (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of---         Right r -> r == 1---         Left _ -> False)------ longestFailBoth :: Property--- longestFailBoth =---     property---         (case S.parse (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of---         Right _ -> False---         Left _ -> True)--many :: Property-many =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        let fldstp conL currL = return $ FL.Partial (conL ++ currL)-            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return-            prsr =-                flip P.many concatFold-                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-         in case runIdentity $ S.parse prsr (S.fromList ls) of-                Right res_list ->-                    checkListEqual res_list (Prelude.filter (== 0) ls)-                Left _ -> property False--many_empty :: Property-many_empty =-    property (case runIdentity $ S.parse (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of-        Right res_list -> checkListEqual res_list ([] :: [Int])-        Left _ -> property False)--some :: Property-some =-    forAll (listOf (chooseInt (0, 1))) $ \genLs ->-        let-            ls = 0 : genLs-            fldstp conL currL = return $ FL.Partial $ conL ++ currL-            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return-            prsr =-                flip P.some concatFold-                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-         in case runIdentity $ S.parse prsr (S.fromList ls) of-                Right res_list -> res_list == Prelude.filter (== 0) ls-                Left _ -> False--someFail :: Property-someFail =-    property (case runIdentity $ S.parse (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------applicative :: Property-applicative =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser =-                    (,)-                        <$> P.fromFold (FL.take (length list1) FL.toList)-                        <*> P.fromFold (FL.take (length list2) FL.toList)-             in-                case runIdentity $ S.parse parser (S.fromList $ list1 ++ list2) of-                    Right (olist1, olist2) -> olist1 == list1 && olist2 == list2-                    Left _ -> False--sequence :: Property-sequence =-    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->-        let p xs = P.fromFold (FL.take (length xs) FL.toList)-         in monadicIO $ do-                outs <- run $-                        S.parse-                            (Prelude.sequence $ fmap p ins)-                            (S.fromList $ concat ins)-                return $-                    case outs of-                        Right ls -> ls == ins-                        Left _ -> False--altEOF1 :: Property-altEOF1 =-    monadicIO $ do-    s1 <- S.parse-        (P.satisfy (> 0) <|> return 66)-        (S.fromList ([]::[Int]))-    return $-        case s1 of-            Right x -> x == 66-            Left _ -> False--altEOF2 :: Property-altEOF2 =-    monadicIO $ do-    s1 <- S.parse-        ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))-        (S.fromList ([51]::[Int]))-    return $-        case s1 of-            Right x -> x == [51]-            Left _ -> False--monad :: Property-monad =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            let parser = do-                    olist1 <- P.fromFold (FL.take (length list1) FL.toList)-                    olist2 <- P.fromFold (FL.take (length list2) FL.toList)-                    return (olist1, olist2)-             in monadicIO $ do-                    s <- S.parse parser (S.fromList $ list1 ++ list2)-                    return $-                        case s of-                            Right (olist1, olist2) -> olist1 == list1 && olist2 == list2-                            Left _ -> False------------------------------------------------------------------------------------ Stream parsing----------------------------------------------------------------------------------parseMany :: Property-parseMany =-    forAll (chooseInt (1,100)) $ \len ->-        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->-            monadicIO $ do-                outs <- do-                    let p = P.fromFold $ FL.take len FL.toList-                    run-                        $ S.fold FL.toList-                        $ S.catRights-                        $ S.parseMany p (S.fromList $ concat ins)-                listEquals (==) outs ins---- basic sanity test for parsing from arrays-parseUnfold :: Property-parseUnfold = do-    let len = 200-    -- ls = input list (stream)-    -- clen = chunk size-    -- tlen = parser take size-    forAll-        ((,,)-            <$> vectorOf len (chooseAny :: Gen Int)-            <*> chooseInt (1, len)-            <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->-        monadicIO $ do-            arrays <- S.toList $ S.chunksOf clen (S.fromList ls)-            let src = Producer.source (Just (Producer.OuterLoop arrays))-            let parser = P.fromFold (FL.take tlen FL.toList)-            let readSrc =-                    Producer.producer-                        $ Producer.concat Producer.fromList A.producer-            let streamParser =-                    Producer.simplify (Producer.parseManyD parser readSrc)-            xs <- run-                $ S.toList-                $ S.unfoldMany Unfold.fromList-                $ S.catRights-                $ S.unfold streamParser src--            listEquals (==) xs ls--parserSequence :: Property-parserSequence =-  forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->-    monadicIO $ do-    let parsers = S.fromList-            $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins-    let sequencedParser = P.sequence parsers FL.sum-    outs <--        S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins)-    return $-        case outs of-            Right x -> x == sum (map sum ins)-            Left _ -> False------------------------------------------------------------------------------------ Test for a particular case hit during fs events testing----------------------------------------------------------------------------------evId :: [Word8]-evId = [96,238,17,9,0,0,0,0]--evFlags :: [Word8]-evFlags = [0,4,1,0,0,0,0,0]--evPathLen :: [Word8]-evPathLen = [71,0,0,0,0,0,0,0]--evPath :: [Word8]-evPath =-    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109-    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112-    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116-    ,114,101,97,109,108,121,47,116,109,112,47,122,122-    ]--event :: [Word8]-event = evId ++ evFlags ++ evPathLen ++ evPath--data Event = Event-   { eventId :: Word64-   , eventFlags :: Word32-   , eventAbsPath :: A.Array Word8-   } deriving (Show, Ord, Eq)--readOneEvent :: P.Parser Word8 IO Event-readOneEvent = do-    arr <- P.takeEQ 24 (A.writeN 24)-    let arr1 = A.castUnsafe arr :: A.Array Word64-        eid = A.getIndexUnsafe 0 arr1-        eflags = A.getIndexUnsafe 1 arr1-        pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1-    -- XXX handle if pathLen is 0-    path <- P.takeEQ pathLen (A.writeN pathLen)-    return $ Event-        { eventId = eid-        , eventFlags = fromIntegral eflags-        , eventAbsPath = path-        }--parseMany2Events :: Property-parseMany2Events =-    monadicIO $ do-        xs <--            ( run-            $ S.fold FL.toList-            $ S.catRights-            $ S.parseMany readOneEvent-            $ S.fromList (concat (replicate 2 event))-            )-        assert (length xs == 2)-        -- XXX assuming little endian machine-        let ev = Event-                { eventId = 152170080-                , eventFlags = 66560-                , eventAbsPath = A.fromList evPath-                }-         in listEquals (==) xs (replicate 2 ev)--manyEqParseMany :: Property-manyEqParseMany =-    forAll (listOf (chooseInt (0, 100))) $ \lst ->-    forAll (chooseInt (1, 100)) $ \i ->-        monadicIO $ do-            let strm = S.fromList lst-            r1 <- run $ S.parse (P.many (split i) FL.toList) strm-            r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm-            return $-                case r1 of-                    Right o1 -> o1 == r2-                    Left _ -> False--    where--    split i = P.fromFold (FL.take i FL.toList)---takeEndBy1 :: Property-takeEndBy1 =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        case runIdentity $ S.parse (P.takeEndBy predicate prsr) (S.fromList ls) of-            Right parsed_list ->-                checkListEqual-                parsed_list-                (takeWhileAndFirstFail (not . predicate) ls)-            Left _ -> property False-        where-            prsr = P.many (P.satisfy (const True)) FL.toList--            predicate = (== 1)--            takeWhileAndFirstFail prd (x : xs) =-                if prd x-                then x : takeWhileAndFirstFail prd xs-                else [x]-            takeWhileAndFirstFail _ [] = []--splitWithSuffix-    :: Monad m-    => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b-splitWithSuffix predicate f =  S.foldMany (FL.takeEndBy predicate f)--takeEndBy2 :: Property-takeEndBy2 =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        let-            strm = S.fromList ls--            predicate = (==0)--            eitherParsedList =-                S.fold FL.toList-                    $ S.catRights-                    $ S.parseMany (P.takeEndBy predicate prsr) strm--                    where--                    prsr = P.many (P.satisfy (const True)) FL.toList--            eitherSplitList =-                case ls of-                    [] -> return []-                    _ ->-                        if last ls == 0-                        then S.fold FL.toList $ S.append strm1 (S.fromList [])-                        else S.fold FL.toList strm1--                        where--                        strm1 = splitWithSuffix predicate FL.toList strm-        in-            case eitherParsedList of-                Left _ -> property False-                Right parsedList ->-                    case eitherSplitList of-                        Left _ -> property False-                        Right splitList -> checkListEqual parsedList splitList--takeEndByEsc :: Property-takeEndByEsc =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        let-            msg = "takeEndByEsc: trailing escape"--            isSep = even--            isEsc x = x `mod` 6 == 0--            prsr = P.takeEndByEsc isEsc isSep prsr0--                where--                prsr0 = P.many (P.satisfy (const True)) FL.toList--            escapeSep maybePrevEsc [] =-                case maybePrevEsc of-                    Nothing -> []-                    Just prevEsc -> [prevEsc]-            escapeSep maybePrevEsc (x : xs) =-                 case maybePrevEsc of-                    Nothing ->-                        if isEsc x-                        then escapeSep (Just x) xs-                        else-                            if isSep x-                            then [x]-                            else x : escapeSep Nothing xs-                    Just _ ->-                            x : escapeSep Nothing xs-        in-            case runIdentity $ S.parse prsr (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls-                Left err -> property (displayException err == msg)--takeFramedByEsc_ :: Property-takeFramedByEsc_ =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        let-            isBegin = (== 0)--            isEnd = (== 1)--            isEsc = (== 2)--            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd  FL.toList--            checkPass (x : xs) maybePrevEsc openMinusClose =-                case maybePrevEsc of-                    Nothing ->-                        if isEsc x-                        then checkPass xs (Just x) openMinusClose-                        else-                            if isBegin x-                            then checkPass xs Nothing (openMinusClose + 1)-                            else-                                if isEnd x-                                then-                                    case openMinusClose of-                                        0 -> False-                                        1 -> True-                                        _ ->-                                            checkPass-                                            xs-                                            Nothing-                                            (openMinusClose - 1)-                                else-                                    checkPass xs Nothing openMinusClose-                    Just _ -> checkPass xs Nothing openMinusClose-            checkPass [] _ _ = False--            checkPassBeg [] = False-            checkPassBeg xxs@(x:_)-                | isBegin x = checkPass xxs Nothing (0 :: Int)-                | otherwise = False--            escapeFrame begin end escape l =-                let-                    helper (x : xs) maybePrevEsc openMinusClose =-                        case maybePrevEsc of-                            Nothing ->-                                if escape x-                                then helper xs (Just x) openMinusClose-                                else-                                    if begin x-                                    then helper xs Nothing (openMinusClose + 1)-                                    else-                                        if end x-                                        then-                                            if openMinusClose - 1 == 0-                                            then []-                                            else-                                                helper-                                                xs-                                                Nothing-                                                (openMinusClose - 1)-                                        else-                                            x : helper xs Nothing openMinusClose-                            Just prevEsc ->-                                if escape x || begin x || end x-                                then x : helper xs Nothing openMinusClose-                                else-                                    prevEsc : x : helper xs Nothing openMinusClose-                    helper [] _ _ = error "Cannot Reach Here"-                in-                    helper l Nothing (0 :: Int)-        in-            case runIdentity $ S.parse prsr (S.fromList ls) of-                Right parsed_list ->-                    if checkPassBeg ls-                    then checkListEqual parsed_list $-                        escapeFrame isBegin isEnd isEsc ls-                    else property False-                Left _ ->-                    if checkPassBeg ls-                    then property False-                    else property True--takeFramedByEsc_Pass :: Property-takeFramedByEsc_Pass =-    forAll (listOf (chooseInt (min_value, max_value))) $ \list ->-        let-            ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)--            isBegin = (== 0)--            isEnd = (== 1)--            isEsc = (== 2)--            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList--            escapeFrame begin end escape l =-                let-                    helper (x : xs) maybePrevEsc openMinusClose =-                        case maybePrevEsc of-                            Nothing ->-                                if escape x-                                then helper xs (Just x) openMinusClose-                                else-                                    if begin x-                                    then-                                        if openMinusClose == 0-                                        then helper xs Nothing (openMinusClose + 1)-                                        else x : helper xs Nothing (openMinusClose + 1)-                                    else-                                        if end x-                                        then-                                            if openMinusClose - 1 == 0-                                            then []-                                            else-                                                x :-                                                helper-                                                xs-                                                Nothing-                                                (openMinusClose - 1)-                                        else-                                            x : helper xs Nothing openMinusClose-                            Just _ ->-                                x : helper xs Nothing openMinusClose-                    helper [] _ _ = error "Cannot Reach Here"-                in-                    helper l Nothing (0 :: Int)-        in-            case runIdentity $ S.parse prsr (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls-                _ -> property False--takeFramedByEsc_Fail1 :: Property-takeFramedByEsc_Fail1 =-    let-        msg = "takeFramedByEsc_: missing frame end"--        isBegin = (== 0)--        isEnd = (== 0)--        isEsc = (== 2)--        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList--        ls = [0 :: Int]-    in-        case runIdentity $ S.parse prsr (S.fromList ls) of-            Right _ -> property False-            Left err -> property (displayException err == msg)--takeFramedByEsc_Fail2 :: Property-takeFramedByEsc_Fail2 =-    let-        msg = "takeFramedByEsc_: missing frame start"--        isBegin = (== 0)--        isEnd = (== 1)--        isEsc = (== 1)--        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList--        ls = [1 :: Int]-    in-        case runIdentity $ S.parse prsr (S.fromList ls) of-            Right _ -> property False-            Left err -> property (displayException err == msg)--takeFramedByEsc_Fail3 :: Property-takeFramedByEsc_Fail3 =-    let-        msg = "takeFramedByEsc_: missing frame end"--        isBegin = (== 2)--        isEnd = (== 1)--        isEsc = (== 2)--        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList--        ls = [2 :: Int]-    in-        case runIdentity $ S.parse prsr (S.fromList ls) of-            Right _ -> property False-            Left err -> property $ (displayException err == msg)--takeStartBy_ :: Property-takeStartBy_ =-     forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        let ls1 = 1:ls-            msg = "takeFramedByGeneric: empty token"-        in-            case runIdentity $ S.parse parser (S.fromList ls1) of-                Right parsed_list ->-                  if not $ Prelude.null ls1-                  then-                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)-                    in checkListEqual parsed_list $-                      if predicate (head ls1)-                      then tls-                      else Prelude.takeWhile (not . predicate) ls1-                  else property $ Prelude.null parsed_list-                Left err -> property (displayException err == msg)-            where-                predicate = odd-                parser = P.takeStartBy_ predicate FL.toList----------------------------------------------------------------------------------- Main----------------------------------------------------------------------------------moduleName :: String-moduleName = "Data.Parser"--main :: IO ()-main =-  hspec $-  H.parallel $-  modifyMaxSuccess (const maxTestCount) $ do-  describe moduleName $ do--    describe "Instances" $ do-        prop "applicative" applicative-        prop "Alternative: end of input 1" altEOF1-        prop "Alternative: end of input 2" altEOF2-        prop "monad" monad-        prop "sequence" sequence-    describe "Stream parsing" $ do-        prop "parseMany" parseMany-        prop "parseMany2Events" parseMany2Events-        prop "parseUnfold" parseUnfold-        prop "parserSequence" parserSequence--    describe "test for accumulator" $ do-        prop "P.fromFold FL.sum = FL.sum" fromFold-        prop "fromPure value provided" fromPure-        prop "fromPure monadic value provided" fromEffect-        prop "fail err = Left (SomeException (ParseError err))" parserFail-        prop "always fail" die-        prop "always fail but monadic" dieM--    describe "test for element parser" $ do-        prop "peek = head with list length > 0" peekPass-        prop "peek fail on []" peekFail-        prop "eof pass on []" eofPass-        prop "eof fail on non-empty list" eofFail-        prop "first element exists and >= mid_value" satisfyPass-        prop "one pass on [Int]" onePass-        prop "one fail on []" one-        prop "check first element exists and satisfies predicate" satisfy--    describe "test for sequence parser" $ do-        prop "P.takeBetween = Prelude.take when len >= m and len <= n"-            takeBetweenPass-        -- XXX This test fails-        -- XXX cabal run test:Data.Parser -- --match "/Data.Parser/test for sequence parser/P.takeBetween = Prelude.take when len >= m and len <= n and failotherwise fail/" --seed 1563586298-        -- prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"-              -- ++ "otherwise fail") Main._takeBetween-        prop "P.take = Prelude.take" Main.take-        prop "P.takeEQ = Prelude.take when len >= n" takeEQPass-        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"-            Main.takeEQ-        prop "P.takeGE n ls = ls when len >= n" takeGEPass-        prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass-        -- prop "Fail when stream length exceeded" lookAheadFail-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead-        prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"-                ++ " tail") takeStartBy-        prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile-        prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"-                ++ " else check why failed") takeWhile1-        prop "takeWhileP prd P.take = takeWhileMaxLen prd" takeWhileP-        prop ("P.takeP = Prelude.take") takeP-        prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy-        prop "groupByRolling" groupByRolling-        prop "many (P.wordBy ' ') = words'" wordBy-        parseManyWordQuotedBy-        -- prop "choice" choice-        prop "parse 0, then 1, else fail" splitWith-        prop "fail due to die as left parser" splitWithFailLeft-        prop "fail due to die as right parser" splitWithFailRight-        prop "fail due to die as both parsers" splitWithFailBoth-        -- prop "" teeWithPass-        -- prop "" teeWithFailLeft-        -- prop "" teeWithFailRight-        -- prop "" teeWithFailBoth-        -- prop "deintercalate" deintercalate-        -- prop "" shortestPass-        -- prop "" shortestFailLeft-        -- prop "" shortestFailRight-        -- prop "" shortestFailBoth-        prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="-                ++ "Prelude.filter (== 0)") many-        prop "[] due to parser being die" many_empty-        prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="-                ++ "Prelude.filter (== 0)") some-        prop "fail due to parser being die" someFail-        prop "P.many == S.parseMany" manyEqParseMany--        prop "takeEndBy_" takeEndBy_-        prop "takeEndByOrMax_" takeEndByOrMax_-        prop "takeEndBy1" takeEndBy1-        prop "takeEndBy2" takeEndBy2-        prop "takeEndByEsc" takeEndByEsc-        prop "takeFramedByEsc_" takeFramedByEsc_-        prop "takeFramedByEsc_Pass" takeFramedByEsc_Pass-        prop "takeFramedByEsc_Fail1" takeFramedByEsc_Fail1-        prop "takeFramedByEsc_Fail2" takeFramedByEsc_Fail2-        prop "takeFramedByEsc_Fail3" takeFramedByEsc_Fail3-        prop "takeStartBy_" takeStartBy_--    takeProperties+{-# Language NoMonoLocalBinds #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+module Main (main) where++import Control.Applicative ((<|>))+import Control.Exception (displayException)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (isSpace)+import Data.Foldable (for_)+import Data.Word (Word8, Word32, Word64)+import Streamly.Internal.Data.Fold (Fold(..))+import Streamly.Internal.Data.Parser (Parser(..), Step(..), Initial(..), Final(..))+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)+import Streamly.Internal.Data.Parser (ParseError(..))+import Test.QuickCheck (forAll, Property, property, listOf, vectorOf, Gen)+import Test.QuickCheck.Monadic (monadicIO, assert, run)++import Prelude hiding (sequence)++import qualified Streamly.Test.Data.Parser.Common as Common+import qualified Streamly.Data.Stream as S+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as P+import qualified Streamly.Internal.Data.ParserK as PK+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Stream as SI+import qualified Streamly.Internal.Data.StreamK as K+import qualified Test.Hspec as H++import Test.Hspec+import Test.Hspec.QuickCheck+import Streamly.Test.Parser.Common++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)++#else++import System.Random (Random(random))+import Test.QuickCheck.Gen (Gen(MkGen))++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++#endif++maxTestCount :: Int+maxTestCount = 100++-------------------------------------------------------------------------------+-- Stream parsing+-------------------------------------------------------------------------------++parseManyWordQuotedBy :: H.SpecWith ()+parseManyWordQuotedBy =+    describe "parseMany wordQuotedBy"+        $ for_ testCases+        $ \c@(kQ, isQ, input, expected) -> do+              let inpStrm = S.fromList input++                  esc = '\\'++                  spc ' ' = True+                  spc _ = False++                  tr _ _ = Nothing++                  parser = P.wordWithQuotes kQ tr esc isQ spc FL.toList+              result <- H.runIO $ S.fold FL.toList $ S.catRights $ S.parseMany parser inpStrm+              H.it (showCase c) $ result `H.shouldBe` expected++    where++    showCase (kQ, _, input, expected) =+        show kQ ++ ", " ++ input ++ " -> " ++ show expected++    testCases =+        [ ( True+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The quick brown fox"+          , ["The", "quick", "brown", "fox"])+        , ( True+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The' quick brown' fox"+          , ["The' quick brown'", "fox"])+        , ( False+          , \x -> if x == '\'' then Just '\'' else Nothing+          , "The' quick brown' fox"+          , ["The quick brown", "fox"])+        , ( True+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ quick brown] fox"+          , ["The[ quick brown]", "fox"])+        , ( True+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ qui[ck] brown] \\ f[  ox]"+          , ["The[ qui[ck] brown]", " f[  ox]"])+        , ( False+          , \x -> if x == '[' then Just ']' else Nothing+          , "The[ qui[ck] brown] fox"+          , ["The qui[ck] brown", "fox"])+        ]++parseMany :: Property+parseMany =+    forAll (chooseInt (1,100)) $ \len ->+        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->+            monadicIO $ do+                outs <- do+                    let p = P.fromFold $ FL.take len FL.toList+                    run+                        $ S.fold FL.toList+                        $ S.catRights+                        $ S.parseMany p (S.fromList $ concat ins)+                listEquals (==) outs ins+++-- basic sanity test for parsing from arrays+parseUnfold :: Property+parseUnfold = do+    let len = 200+    -- ls = input list (stream)+    -- clen = chunk size+    -- tlen = parser take size+    forAll+        ((,,)+            <$> vectorOf len (chooseAny :: Gen Int)+            <*> chooseInt (1, len)+            <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->+        monadicIO $ do+            arrays <- S.toList $ A.chunksOf clen (S.fromList ls)+            let src = Producer.source (Just (Producer.OuterLoop arrays))+            let parser = P.fromFold (FL.take tlen FL.toList)+            let readSrc =+                    Producer.producer+                        $ Producer.concat Producer.fromList A.producer+            let streamParser =+                    Producer.simplify (Producer.parseManyD parser readSrc)+            xs <- run+                $ S.toList+                $ S.unfoldEach Unfold.fromList+                $ S.catRights+                $ S.unfold streamParser src++            listEquals (==) xs ls++parserSequence :: Property+parserSequence =+  forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->+    monadicIO $ do+    let parsers = S.fromList+            $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins+    let sequencedParser = P.sequence parsers FL.sum+    outs <-+        S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins)+    return $+        case outs of+            Right x -> x == sum (map sum ins)+            Left _ -> False++-------------------------------------------------------------------------------+-- Test for a particular case hit during fs events testing+-------------------------------------------------------------------------------++evId :: [Word8]+evId = [96,238,17,9,0,0,0,0]++evFlags :: [Word8]+evFlags = [0,4,1,0,0,0,0,0]++evPathLen :: [Word8]+evPathLen = [71,0,0,0,0,0,0,0]++evPath :: [Word8]+evPath =+    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109+    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112+    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116+    ,114,101,97,109,108,121,47,116,109,112,47,122,122+    ]++event :: [Word8]+event = evId ++ evFlags ++ evPathLen ++ evPath++data Event = Event+   { eventId :: Word64+   , eventFlags :: Word32+   , eventAbsPath :: A.Array Word8+   } deriving (Show, Ord, Eq)++readOneEvent :: P.Parser Word8 IO Event+readOneEvent = do+    arr <- P.takeEQ 24 (A.createOf 24)+    let arr1 = A.unsafeCast arr :: A.Array Word64+        eid = A.unsafeGetIndex 0 arr1+        eflags = A.unsafeGetIndex 1 arr1+        pathLen = fromIntegral $ A.unsafeGetIndex 2 arr1+    -- XXX handle if pathLen is 0+    path <- P.takeEQ pathLen (A.createOf pathLen)+    return $ Event+        { eventId = eid+        , eventFlags = fromIntegral eflags+        , eventAbsPath = path+        }++parseMany2Events :: Property+parseMany2Events =+    monadicIO $ do+        xs <-+            ( run+            $ S.fold FL.toList+            $ S.catRights+            $ S.parseMany readOneEvent+            $ S.fromList (concat (replicate 2 event))+            )+        assert (length xs == 2)+        -- XXX assuming little endian machine+        let ev = Event+                { eventId = 152170080+                , eventFlags = 66560+                , eventAbsPath = A.fromList evPath+                }+         in listEquals (==) xs (replicate 2 ev)++--------------------------------------------------------------------------------+-- Parser sequence tests+--------------------------------------------------------------------------------++manyEqParseMany :: Property+manyEqParseMany =+    forAll (listOf (chooseInt (0, 100))) $ \lst ->+    forAll (chooseInt (1, 100)) $ \i ->+        monadicIO $ do+            let strm = S.fromList lst+            r1 <- run $ S.parse (P.many (split i) FL.toList) strm+            r2 <- run $ S.fold FL.toList $ S.catRights $ S.parseMany (split i) strm+            return $+                case r1 of+                    Right o1 -> o1 == r2+                    Left _ -> False++    where++    split i = P.fromFold (FL.take i FL.toList)++splitWithSuffix+    :: Monad m+    => (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b+splitWithSuffix predicate f =  S.foldMany (FL.takeEndBy predicate f)++takeEndBy2 :: Property+takeEndBy2 =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        let+            strm = S.fromList ls++            predicate = (==0)++            eitherParsedList =+                S.fold FL.toList+                    $ S.catRights+                    $ S.parseMany (P.takeEndBy predicate prsr) strm++                    where++                    prsr = P.many (P.satisfy (const True)) FL.toList++            eitherSplitList =+                case ls of+                    [] -> return []+                    _ ->+                        if last ls == 0+                        then S.fold FL.toList $ S.append strm1 (S.fromList [])+                        else S.fold FL.toList strm1++                        where++                        strm1 = splitWithSuffix predicate FL.toList strm+        in+            case eitherParsedList of+                Left _ -> property False+                Right parsedList ->+                    case eitherSplitList of+                        Left _ -> property False+                        Right splitList -> checkListEqual parsedList splitList+++--------------------------------------------------------------------------------+-- Parser quoted word tests+--------------------------------------------------------------------------------++quotedWordTest :: String -> [String] -> IO ()+quotedWordTest inp expected = do+    res <-+        S.fold FL.toList+            $ catRightsErr+            $ S.parseMany quotedWord $ S.fromList inp+    res `shouldBe` expected+    where+    catRightsErr = fmap (either (error . displayException) id)+    quotedWord =+        let toRQuote x =+                case x of+                    '"' -> Just x+                    '\'' -> Just x+                    _ -> Nothing+            -- Inside ",+            -- * \\ is translated to \+            -- * \" is translated to "+            trEsc '"' x =+                case x of+                    '\\' -> Just '\\'+                    '"' -> Just '"'+                    _ -> Nothing+            trEsc _ _ = Nothing+         in P.wordWithQuotes False trEsc '\\' toRQuote isSpace FL.toList++--------------------------------------------------------------------------------+-- Parser sanity tests+--------------------------------------------------------------------------------++{-+TODO:+Add sanity tests for+- Producer.parse+- Producer.parseMany+-}++sanityParseBreak :: [Move] -> SpecWith ()+sanityParseBreak jumps = it (show jumps) $ do+    (val, rest) <- SI.parseBreakPos (jumpParser jumps) $ S.fromList tape+    lst <- S.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape)++sanityParseDBreak :: [Move] -> SpecWith ()+sanityParseDBreak jumps = it (show jumps) $ do+    (val, rest) <- K.parseBreakPos (PK.toParserK (jumpParser jumps)) $ K.fromList tape+    lst <- K.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape)++{-+sanityParseBreakChunksK :: [Move] -> SpecWith ()+sanityParseBreakChunksK jumps = it (show jumps) $ do+    (val, rest) <-+        A.parseBreakChunksK (jumpParser jumps)+            $ K.fromList $ Prelude.map A.fromList chunkedTape+    lst <- Prelude.map A.toList <$> K.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape)+-}++sanityParseMany :: [Move] -> SpecWith ()+sanityParseMany jumps = it (show jumps) $ do+    res <- S.toList $ SI.parseManyPos (jumpParser jumps) $ S.fromList tape+    res `shouldBe` (expectedResultMany jumps tape)++sanityParseIterate :: [Move] -> SpecWith ()+sanityParseIterate jumps = it (show jumps) $ do+    res <-+        S.toList+             $ SI.parseIteratePos (const (jumpParser jumps)) [] $ S.fromList tape+    res `shouldBe` (expectedResultMany jumps tape)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++{-# INLINE takeWhileFailD #-}+takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeWhileFailD predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $ case res of+            FL.Partial s -> IPartial s+            FL.Done b -> IDone b++    step s a =+        if predicate a+        then do+            fres <- fstep s a+            return+                $ case fres of+                      FL.Partial s1 -> SContinue 1 s1+                      FL.Done b -> SDone 1 b+        else return $ SError "fail"++    extract s = fmap (FDone 0) (ffinal s)++{-# INLINE takeWhileFail #-}+takeWhileFail :: MonadIO m =>+    (a -> Bool) -> Fold m a b -> PK.ParserK a m b+takeWhileFail p f = PK.toParserK (takeWhileFailD p f)++{-# INLINE takeWhileK #-}+takeWhileK :: MonadIO m => (a -> Bool) -> PK.ParserK a m [a]+takeWhileK p = PK.toParserK $ P.takeWhile p FL.toList++{-# INLINE alt2 #-}+alt2 :: MonadIO m => K.StreamK m Int -> m (Either ParseError [Int])+alt2 =+    K.parse+        (   takeWhileFail (<= 5) FL.toList+        <|> takeWhileK (<= 7)+        )++{-# INLINE altD #-}+altD :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int])+altD =+    S.parse+        (   takeWhileFailD (<= 5) FL.toList+        <|> P.takeWhile (<= 7) FL.toList+        )++altTests :: Spec+altTests =+    describe "alt" $ do+        it "alt2 [1..20]" $ alt2 (K.fromList [1..20]) `shouldReturn` Right [1..7]+        it "altD [1..20]" $ altD (S.fromList [1..20]) `shouldReturn` Right [1..7]++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++moduleName :: String+moduleName = "Data.Parser"++main :: IO ()+main = do+  hspec $+      H.parallel $+      modifyMaxSuccess (const maxTestCount) $ do+      describe moduleName $ do+        parserSanityTests "Stream.parseBreak" sanityParseBreak+        parserSanityTests "StreamK.parseDBreak" sanityParseDBreak+        -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK+        parserSanityTests "Stream.parseMany" sanityParseMany+        parserSanityTests "Stream.parseIterate" sanityParseIterate+        describe "Stream parsing" $ do+            prop "parseMany" parseMany+            prop "parseMany2Events" parseMany2Events+            prop "parseUnfold" parseUnfold+            prop "parserSequence" parserSequence++        describe "test for sequence parser" $ do+            parseManyWordQuotedBy+            prop "P.many == S.parseMany" manyEqParseMany+            prop "takeEndBy2" takeEndBy2++        describe "quotedWordTest" $ do+            it "Single quote test" $ do+               quotedWordTest "'hello\\\\\"world'" ["hello\\\\\"world"]+               quotedWordTest "'hello\\'" ["hello\\"]+            it "Double quote test" $ do+               quotedWordTest+                   "\"hello\\\"\\\\w\\'orld\""+                   ["hello\"\\w\\'orld"]+++        altTests+        Common.main
+ test/Streamly/Test/Data/Parser/Common.hs view
@@ -0,0 +1,1241 @@+{-# Language NoMonoLocalBinds #-}+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+module Streamly.Test.Data.Parser.Common (main) where++import Control.Applicative ((<|>))+import Control.Exception (displayException, try, evaluate, SomeException)+import Data.List (isSuffixOf)+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)+import Streamly.Internal.Data.Parser (ParseErrorPos(..))+import Test.QuickCheck+       (arbitrary, forAll, elements, Property, property, listOf,+        vectorOf, Gen, (.&&.), ioProperty)+import Test.QuickCheck.Monadic (monadicIO, assert, run, PropertyM)++import Prelude hiding (sequence)++import qualified Control.Monad.Fail as Fail+import qualified Data.List as List+import qualified Prelude+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array.Generic as GA+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as P+import qualified Streamly.Internal.Data.ParserK as PK+import qualified Streamly.Internal.Data.StreamK as K++import Test.Hspec+import Test.Hspec.QuickCheck++#if MIN_VERSION_QuickCheck(2,14,0)++import Test.QuickCheck (chooseAny)+import Control.Monad.Identity (Identity(runIdentity, Identity))++#else++import System.Random (Random(random))+import Test.QuickCheck.Gen (Gen(MkGen))++-- | Generates a random element over the natural range of `a`.+chooseAny :: Random a => Gen a+chooseAny = MkGen (\r _ -> let (x,_) = random r in x)++#endif++min_value :: Int+min_value = 0++mid_value :: Int+mid_value = 5000++max_value :: Int+max_value = 10000++max_length :: Int+max_length = 1000++-- Accumulator Tests++-- TODO: Replace ParserTestCase_Temp with ParserTestCase in all the test cases.++type ParserTestCase a m b c =+        (P.Parser a m b -> [a] -> m (Either ParseErrorPos b, [a])) -> c++type ParserTestCase_Temp a m b c =+        forall t. ([a] -> t)+        -> (P.Parser a m b -> t -> m (Either ParseErrorPos b))+        -> c++fromFold :: ParserTestCase Int IO Int Property+fromFold consumer =+    forAll (listOf $ chooseInt (min_value, max_value)) $ \ls ->+        ioProperty $ do+        (s1, rest) <- consumer (P.fromFold FL.sum) ls+        o2 <- S.fold FL.sum (S.fromList ls)+        pure $ rest == [] &&+            case s1 of+                Right o1 -> o1 == o2+                Left _ -> False++fromPure :: ParserTestCase Int Identity Int Property+fromPure consumer =+    forAll (chooseInt (min_value, max_value)) $ \x ->+        case runIdentity $ consumer (P.fromPure x) [1 :: Int] of+            (Right r, rest) -> r == x && rest == [1 :: Int]+            (Left _, _) -> False++fromEffect :: ParserTestCase Int Identity Int Property+fromEffect consumer =+    forAll (chooseInt (min_value, max_value)) $ \x ->+        case runIdentity $ consumer (P.fromEffect $ return x) [1 :: Int] of+            (Right r, rest) -> r == x && rest == [1 :: Int]+            (Left _, _) -> False++die :: ParserTestCase Int Identity Int Property+die consumer =+    property $+    case runIdentity $ consumer (P.die "die test") [0 :: Int] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [0 :: Int]++dieM :: ParserTestCase Int Identity Int Property+dieM consumer =+    property $+    case runIdentity $ consumer (P.dieM (Identity "die test")) [0 :: Int] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [0 :: Int]++parserFail :: ParserTestCase Int Identity Int Property+parserFail consumer =+    property $+        case runIdentity $ consumer (Fail.fail err) [0 :: Int] of+            (Right _, _) -> False+            (Left (ParseErrorPos _ e), rest) -> err == e && rest == [0 :: Int]+    where+    err = "Testing MonadFail.fail."++-- Element Parser Tests++peekPass :: ParserTestCase Int Identity Int Property+peekPass consumer =+    forAll (chooseInt (1, max_length)) $ \list_length ->+        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer P.peek ls of+                (Right head_value, rest) -> case ls of+                    head_ls : _ -> head_value == head_ls && rest == ls+                    _ -> False+                (Left _, _) -> False++peekFail :: ParserTestCase Int Identity Int Property+peekFail consumer =+    property (case runIdentity $ consumer P.peek [] of+        (Right _, _) -> False+        (Left _, rest) -> rest == [])++eofPass :: ParserTestCase_Temp Int Identity () Property+eofPass producer consumer =+    property (case runIdentity $ consumer P.eof (producer []) of+        Right _ -> True+        Left _ -> False)++eofFail :: ParserTestCase_Temp Int Identity () Property+eofFail producer consumer =+    forAll (chooseInt (1, max_length)) $ \list_length ->+        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer P.eof (producer ls) of+                Right _ -> False+                Left _ -> True++satisfyPass :: ParserTestCase_Temp Int Identity Int Property+satisfyPass producer consumer =+    forAll (chooseInt (mid_value, max_value)) $ \first_element ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->+            let+                ls = first_element : ls_tail+                predicate = (>= mid_value)+            in+                case runIdentity $ consumer (P.satisfy predicate) (producer ls) of+                    Right r -> r == first_element+                    Left _ -> False++satisfy :: ParserTestCase_Temp Int Identity Int Property+satisfy producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        case runIdentity $ consumer (P.satisfy predicate) (producer ls) of+            Right r -> case ls of+                [] -> False+                (x : _) -> predicate x && (r == x)+            Left _ -> case ls of+                [] -> True+                (x : _) -> not $ predicate x+        where+            predicate = (>= mid_value)++onePass :: ParserTestCase_Temp Int Identity Int Property+onePass producer consumer =+    forAll (chooseInt (1, max_value)) $ \int ->+        property (case runIdentity $ consumer P.one (producer [int]) of+            Right i -> i  == int+            Left _ -> False)++one :: ParserTestCase_Temp Int Identity Int Property+one producer consumer =+    property $+        case runIdentity $ consumer P.one (producer []) of+            Left _ -> True+            Right _ -> False++-- Sequence Parsers Tests+takeBetweenPass :: ParserTestCase_Temp Int Identity [Int] Property+takeBetweenPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \m ->+        forAll (chooseInt (m, max_value)) $ \n ->+            forAll (chooseInt (m, max_value)) $ \list_length ->+                forAll (vectorOf list_length (chooseInt (min_value, max_value)))+                    $ \ls ->+                        case runIdentity $ consumer (P.takeBetween m n FL.toList)+                                (producer ls) of+                            Right parsed_list ->+                                let lpl = Prelude.length parsed_list+                                in checkListEqual parsed_list+                                    $ Prelude.take lpl ls+                            Left _ -> property False++takeBetween :: ParserTestCase_Temp Int Identity [Int] Property+takeBetween producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \m ->+        forAll (chooseInt (min_value, max_value)) $ \n ->+            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+                ioProperty $ go m n ls++    where++    go m n ls = do+        let inputLen = Prelude.length ls+        let p = P.takeBetween m n FL.toList+        eres <- try $ evaluate $ runIdentity $ consumer p (producer ls)+        pure $ case eres of+            Left (_ :: SomeException) -> m >= 0 && n >= 0 && m > n+            Right (Right xs) ->+                let parsedLen = Prelude.length xs+                in (inputLen >= m && parsedLen >= m && parsedLen <= n)+                       && (xs == Prelude.take parsedLen ls)+            Right (Left _) -> inputLen < m+++take :: ParserTestCase_Temp Int Identity [Int] Property+take producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            case runIdentity $ consumer (P.fromFold $ FL.take n FL.toList) (producer ls) of+                Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)+                Left _ -> property False++takeEQPass :: ParserTestCase_Temp Int Identity [Int] Property+takeEQPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (chooseInt (n, max_value)) $ \list_length ->+            forAll (vectorOf list_length+                        (chooseInt (min_value, max_value))) $ \ls ->+                case runIdentity $ consumer (P.takeEQ n FL.toList) (producer ls) of+                    Right parsed_list ->+                        checkListEqual parsed_list (Prelude.take n ls)+                    Left _ -> property False++takeEQ :: ParserTestCase_Temp Int Identity [Int] Property+takeEQ producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            let+                list_length = Prelude.length ls+            in+                case runIdentity $ consumer (P.takeEQ n FL.toList) (producer ls) of+                    Right parsed_list ->+                        if n <= list_length+                        then checkListEqual parsed_list (Prelude.take n ls)+                        else property False+                    Left _ -> property (n > list_length)++takeGEPass :: ParserTestCase_Temp Int Identity [Int] Property+takeGEPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (chooseInt (n, max_value)) $ \list_length ->+            forAll (vectorOf list_length (chooseInt (min_value, max_value)))+                $ \ls ->+                    case runIdentity $ consumer (P.takeGE n FL.toList) (producer ls) of+                        Right parsed_list -> checkListEqual parsed_list ls+                        Left _ -> property False++takeGE :: ParserTestCase_Temp Int Identity [Int] Property+takeGE producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+            let+                list_length = Prelude.length ls+            in+                case runIdentity $ consumer (P.takeGE n FL.toList) (producer ls) of+                    Right parsed_list ->+                        if n <= list_length+                        then checkListEqual parsed_list ls+                        else property False+                    Left _ -> property (n > list_length)++nLessThanEqual0 ::+       (  Int+       -> FL.Fold Identity Int [Int]+       -> P.Parser Int Identity [Int]+       )+    -> (Int -> [Int] -> [Int])+    -> ParserTestCase_Temp Int Identity [Int] Property+nLessThanEqual0 tk ltk producer consumer =+    forAll (elements [0, (-1)]) $ \n ->+        forAll (listOf arbitrary) $ \ls ->+            case runIdentity $ consumer (tk n FL.toList) (producer ls) of+                Right parsed_list -> checkListEqual parsed_list (ltk n ls)+                Left _ -> property False++takeProperties :: ParserTestCase_Temp Int Identity [Int] Spec+takeProperties producer consumer =+    describe "take combinators when n <= 0/" $ do+        prop "takeEQ n FL.toList = []" $+            nLessThanEqual0 P.takeEQ (\_ -> const []) producer consumer+        prop "takeGE n FL.toList xs = xs" $+            nLessThanEqual0 P.takeGE (\_ -> id) producer consumer++-- XXX lookAhead can't deal with EOF which in this case means when+-- n==list_length, this test will fail. So excluding that case for now.+lookAheadPass :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+lookAheadPass producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        let+            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+            parseTwice = do+                parsed_list_1 <- takeWithoutConsume+                parsed_list_2 <- takeWithoutConsume+                return (parsed_list_1, parsed_list_2)+        in+            forAll (chooseInt (n+1, max_value)) $ \list_length ->+                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+                    case runIdentity $ consumer parseTwice (producer ls) of+                        Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+                        Left _ -> property $ False++-- lookAheadFail :: ParserTestCase_Temp Int Identity Int Property+-- lookAheadFail producer consumer =+--     forAll (chooseInt (min_value + 1, max_value)) $ \n ->+--         let+--             takeWithoutConsume = P.lookAhead $ P.take n FL.toList+--             parseTwice = do+--                 parsed_list_1 <- takeWithoutConsume+--                 parsed_list_2 <- takeWithoutConsume+--                 return (parsed_list_1, parsed_list_2)+--         in+--             forAll (chooseInt (min_value, n - 1)) $ \list_length ->+--                 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->+--                     case consumer parseTwice (producer ls) of+--                         Right _ -> False+--                         Left _ -> True++lookAhead :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+lookAhead producer consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        let+            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList+            parseTwice = do+                parsed_list_1 <- takeWithoutConsume+                parsed_list_2 <- takeWithoutConsume+                return (parsed_list_1, parsed_list_2)+        in+            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+                case runIdentity $ consumer parseTwice (producer ls) of+                    Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)+                    Left _ -> property ((list_length < n) || (list_length == n && n == 0))+                        where+                            list_length = Prelude.length ls++listTakeEndBy_ :: (a -> Bool) -> [a] -> ([a], [a])+listTakeEndBy_ predicate ls =+    case break predicate ls of+        (a, []) -> (a, [])+        (a, b) -> (a, tail b)++takeEndBy_ :: ParserTestCase Int Identity [Int] Property+takeEndBy_ consumer =+    forAll (listOf (chooseInt (min_value, max_value )))  $ \ls ->+        case runIdentity $ consumer (P.takeEndBy_ predicate prsr) ls of+            (Right parsed_list, rest) -> monadicIO $ do+                let (ls1, ls2) = listTakeEndBy_ predicate ls+                listEquals (==) parsed_list ls1+                listEquals (==) rest ls2+            _ -> property False+        where+            predicate = (>= 100)+            prsr = P.many (P.satisfy (const True)) FL.toList++takeEndByOrMax_ :: ParserTestCase Int Identity [Int] Property+takeEndByOrMax_ consumer =+    forAll (chooseInt (min_value, max_value)) $ \n ->+        forAll (listOf (chooseInt (0, 1))) $ \ls ->+            case runIdentity $ consumer (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) ls of+                (Right parsed_list, rest) -> monadicIO $ do+                    let (lsa, lsb) = listTakeEndBy_ predicate ls+                        (ls1, ls2) = Prelude.splitAt n ls+                    if length lsa < length ls1+                    then do+                        listEquals (==) parsed_list lsa+                        listEquals (==) rest lsb+                    else do+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                _ -> property False+            where+                predicate = (== 1)++takeStartBy :: ParserTestCase Int Identity [Int] Property+takeStartBy consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let ls1 = 1:ls+        in+            case runIdentity $ consumer parser ls1 of+                (Right parsed_list, rest) ->+                  if not $ Prelude.null ls1+                  then+                    let (rls1, rls2) = Prelude.break predicate (tail ls1)+                    in monadicIO $ do+                           listEquals (==) parsed_list (head ls1 : rls1)+                           listEquals (==) rest rls2+                  else property $ Prelude.null parsed_list && Prelude.null rest+                _ -> property False+            where+                predicate = odd+                parser = P.takeBeginBy predicate FL.toList++takeWhile :: ParserTestCase Int Identity [Int] Property+takeWhile consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ ls ->+        case runIdentity $ consumer (P.takeWhile predicate FL.toList) ls of+            (Right parsed_list, rest) -> monadicIO $ do+                let (ls1, ls2) = Prelude.span predicate ls+                listEquals (==) parsed_list ls1+                listEquals (==) rest ls2+            _ -> property False+        where+            predicate = (== 0)++takeP :: ParserTestCase Int Identity [Int] Property+takeP consumer =+    forAll+        ((,) <$> chooseInt (min_value, max_value)+             <*> listOf (chooseInt (0, 1)))+        $ \(takeNum, ls) ->+              case runIdentity $ consumer+                       (P.takeP takeNum (P.fromFold FL.toList)) ls of+                  (Right parsed_list, rest) -> monadicIO $ do+                      let (ls1, ls2) = Prelude.splitAt takeNum ls+                      listEquals (==) parsed_list ls1+                      listEquals (==) rest ls2+                  _ -> property False++takeWhile1 :: ParserTestCase Int Identity [Int] Property+takeWhile1 consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ ls ->+        case runIdentity $ consumer (P.takeWhile1 predicate  FL.toList) ls of+            (Right parsed_list, rest) -> case ls of+                [] -> property False+                (x : _) ->+                    if predicate x+                    then monadicIO $ do+                        let (ls1, ls2) = span predicate ls+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                    else+                        property False+            (Left _, rest) -> monadicIO $ do+                listEquals (==) rest ls+                case ls of+                    [] -> assert True+                    (x : _) -> assert (not $ predicate x)+        where+            predicate = (== 0)++takeWhileP :: ParserTestCase Int Identity [Int] Property+takeWhileP consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        forAll (chooseInt (min_value, max_value)) $ \n ->+            let+                predicate = (== 1)++                prsr =+                    P.takeWhileP predicate+                        $ P.fromFold (FL.take n FL.toList)++                takeWhileTillLen maxLen prd list =+                    Prelude.take maxLen $ Prelude.takeWhile prd list+            in+                case runIdentity $ consumer prsr ls of+                    (Right parsed_list, rest) -> monadicIO $ do+                        let ls1 = takeWhileTillLen n predicate ls+                            ls2 = drop (length ls1) ls+                        listEquals (==) parsed_list ls1+                        listEquals (==) rest ls2+                    _ -> property False++{-+choice :: ParserTestCase_Temp Int Identity Int Property+choice producer consumer =+    forAll+        ((,,) <$> chooseInt (min_value, max_value)+             <*> chooseInt (min_value, max_value)+             <*> listOf (chooseInt (0, 1)))+        $ \(i, j, ls) ->+              case consumer (P.choice [parser i, parser j]) (producer ls) of+                  Right parsed_list ->+                      checkListEqual parsed_list $ take (min i j) ls+                  Left _ -> property False++    where++    parser i = P.fromFold (FL.take i FL.toList)+-}++groupBy :: ParserTestCase_Temp Int Identity [Int] Property+groupBy producer consumer =+    forAll (listOf (chooseInt (0, 1)))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (groupByLF ls)+                  Left _ -> property False++    where++    cmp = (==)+    parser = P.groupBy cmp FL.toList+    groupByLF lst+        | null lst = []+        | otherwise = head $ List.groupBy cmp lst++groupByRolling :: ParserTestCase_Temp Int Identity [Int] Property+groupByRolling producer consumer =+    forAll (listOf (chooseInt (0, 1)))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (groupByLF Nothing ls)+                  Left _ -> property False++    where++    cmp = (==)+    parser = P.groupBy cmp FL.toList+    groupByLF _ [] = []+    groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs+    groupByLF (Just y) (x:xs) =+        if cmp y x+        then x : groupByLF (Just x) xs+        else []++wordBy :: ParserTestCase_Temp Char Identity [String] Property+wordBy producer consumer =+    forAll (listOf (elements [' ', 's']))+        $ \ls ->+              case runIdentity $ consumer parser (producer ls) of+                  Right parsed -> checkListEqual parsed (words' ls)+                  Left _ -> property False++    where++    predicate = (== ' ')+    parser = P.many (P.wordBy predicate FL.toList) FL.toList+    words' lst =+        let wrds = words lst+         in if wrds == [] && length lst > 0 then [""] else wrds++splitWith :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWith producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        case runIdentity $ consumer (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (producer ls) of+            Right (result_first, result_second) -> case ls of+                0 : 1 : _ -> (result_first == 0) && (result_second == 1)+                _ -> False+            Left _ -> case ls of+                0 : 1 : _ -> False+                _ -> True++splitWithFailLeft :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailLeft producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++splitWithFailRight :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailRight producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++splitWithFailBoth :: ParserTestCase_Temp Int Identity (Int, Int) Property+splitWithFailBoth producer consumer =+    property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++-- teeWithPass :: ParserTestCase_Temp Int Identity Int Property+-- teeWithPass producer consumer =+--     forAll (chooseInt (min_value, max_value)) $ \n ->+--         forAll (listOf (chooseInt (0, 1))) $ \ls ->+--             let+--                 prsr = P.fromFold $ FL.take n FL.toList+--             in+--                 case consumer (P.teeWith (,) prsr prsr) (producer ls) of+--                     Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2+--                     Left _ -> property False++-- teeWithFailLeft :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailLeft producer consumer =+--     property (case consumer (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++-- teeWithFailRight :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailRight producer consumer =+--     property (case consumer (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++-- teeWithFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- teeWithFailBoth producer consumer =+--     property (case consumer (P.teeWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++{-+deintercalate :: ParserTestCase_Temp Int Identity Int Property+deintercalate producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ls ->+        case runIdentity $ consumer p (producer ls) of+            Right evenOdd -> evenOdd == List.partition even ls+            Left _ -> False++        where+            p1 = P.takeWhile even FL.toList+            p2 = P.takeWhile odd FL.toList+            partition =+                FL.tee (fmap concat $ FL.catLefts FL.toList)+                       (fmap concat $ FL.catRights FL.toList)+            p = P.deintercalate p1 p2 partition+-}++-- shortestPass :: ParserTestCase_Temp Int Identity Int Property+-- shortestPass producer consumer =+--     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+--         let+--             half_mid_value = mid_value `Prelude.div` 2+--             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+--             prsr_2 = P.takeWhile (<= mid_value) FL.toList+--             prsr_shortest = P.shortest prsr_1 prsr_2+--         in+--             case consumer prsr_shortest (producer ls) of+--                 Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)+--                 Left _ -> property False++-- shortestPassLeft :: ParserTestCase_Temp Int Identity Int Property+-- shortestPassLeft producer consumer =+--     property (case consumer (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- shortestPassRight :: ParserTestCase_Temp Int Identity Int Property+-- shortestPassRight producer consumer =+--     property (case consumer (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)++-- shortestFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- shortestFailBoth producer consumer =+--     property+--         (case consumer+--                   (P.shortest (P.die "die") (P.die "die"))+--                   (producer [1 :: Int]) of+--              Right _ -> False+--              Left _ -> True)+--+-- longestPass :: ParserTestCase_Temp Int Identity Int Property+-- longestPass producer consumer =+--     forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->+--         let+--             half_mid_value = mid_value `Prelude.div` 2+--             prsr_1 = P.takeWhile (<= half_mid_value) FL.toList+--             prsr_2 = P.takeWhile (<= mid_value) FL.toList+--             prsr_longest = P.longest prsr_1 prsr_2+--         in+--             case consumer prsr_longest (producer ls) of+--                 Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls+--                 Left _ -> False+--+-- longestPassLeft :: ParserTestCase_Temp Int Identity Int Property+-- longestPassLeft producer consumer =+--     property (case consumer (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- longestPassRight :: ParserTestCase_Temp Int Identity Int Property+-- longestPassRight producer consumer =+--     property (case consumer (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of+--         Right r -> r == 1+--         Left _ -> False)+--+-- longestFailBoth :: ParserTestCase_Temp Int Identity Int Property+-- longestFailBoth producer consumer =+--     property+--         (case consumer (P.shortest (P.die "die") (P.die "die")) (producer [1 :: Int]) of+--         Right _ -> False+--         Left _ -> True)++many :: ParserTestCase_Temp Int Identity [Int] Property+many producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        let fldstp conL currL = return $ FL.Partial (conL ++ currL)+            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return+            prsr =+                flip P.many concatFold+                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+         in case runIdentity $ consumer prsr (producer ls) of+                Right res_list ->+                    checkListEqual res_list (Prelude.filter (== 0) ls)+                Left _ -> property False++many_empty :: ParserTestCase_Temp Int Identity [Int] Property+many_empty producer consumer =+    property (case runIdentity $ consumer (flip P.many FL.toList (P.die "die")) (producer [1 :: Int]) of+        Right res_list -> checkListEqual res_list ([] :: [Int])+        Left _ -> property False)++some :: ParserTestCase_Temp Int Identity [Int] Property+some producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \genLs ->+        let+            ls = 0 : genLs+            fldstp conL currL = return $ FL.Partial $ conL ++ currL+            concatFold = FL.Fold fldstp (return (FL.Partial [])) return return+            prsr =+                flip P.some concatFold+                    $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList+         in case runIdentity $ consumer prsr (producer ls) of+                Right res_list -> res_list == Prelude.filter (== 0) ls+                Left _ -> False++someFail :: ParserTestCase_Temp Int Identity [Int] Property+someFail producer consumer =+    property (case runIdentity $ consumer (P.some (P.die "die") FL.toList) (producer [1 :: Int]) of+        Right _ -> False+        Left _ -> True)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++applicative :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property+applicative producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+            let parser =+                    (,)+                        <$> P.fromFold (FL.take (length list1) FL.toList)+                        <*> P.fromFold (FL.take (length list2) FL.toList)+             in+                case runIdentity $ consumer parser (producer $ list1 ++ list2) of+                    Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+                    Left _ -> False++sequence :: ParserTestCase_Temp Int IO [[Int]] Property+sequence producer consumer =+    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->+        let p xs = P.fromFold (FL.take (length xs) FL.toList)+         in monadicIO $ do+                outs <- run $+                        consumer+                            (Prelude.sequence $ fmap p ins)+                            (producer $ concat ins)+                return $+                    case outs of+                        Right ls -> ls == ins+                        Left _ -> False++altEOF1 :: ParserTestCase_Temp Int (PropertyM IO) Int Property+altEOF1 producer consumer =+    monadicIO $ do+    s1 <- consumer+        (P.satisfy (> 0) <|> return 66)+        (producer ([]::[Int]))+    return $+        case s1 of+            Right x -> x == 66+            Left _ -> False++altEOF2 :: ParserTestCase_Temp Int (PropertyM IO) [Int] Property+altEOF2 producer consumer =+    monadicIO $ do+    s1 <- consumer+        ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))+        (producer ([51]::[Int]))+    return $+        case s1 of+            Right x -> x == [51]+            Left _ -> False++monad :: ParserTestCase_Temp Int (PropertyM IO) ([Int], [Int]) Property+monad producer consumer =+    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->+        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->+            let parser = do+                    olist1 <- P.fromFold (FL.take (length list1) FL.toList)+                    olist2 <- P.fromFold (FL.take (length list2) FL.toList)+                    return (olist1, olist2)+             in monadicIO $ do+                    s <- consumer parser (producer $ list1 ++ list2)+                    return $+                        case s of+                            Right (olist1, olist2) -> olist1 == list1 && olist2 == list2+                            Left _ -> False++takeEndBy1 :: ParserTestCase_Temp Int Identity [Int] Property+takeEndBy1 producer consumer =+    forAll (listOf (chooseInt (0, 1))) $ \ls ->+        case runIdentity $ consumer (P.takeEndBy predicate prsr) (producer ls) of+            Right parsed_list ->+                checkListEqual+                parsed_list+                (takeWhileAndFirstFail (not . predicate) ls)+            Left _ -> property False+        where+            prsr = P.many (P.satisfy (const True)) FL.toList++            predicate = (== 1)++            takeWhileAndFirstFail prd (x : xs) =+                if prd x+                then x : takeWhileAndFirstFail prd xs+                else [x]+            takeWhileAndFirstFail _ [] = []++takeEndByEsc :: ParserTestCase_Temp Int Identity [Int] Property+takeEndByEsc producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let+            msg = "takeEndByEsc: trailing escape"++            isSep = even++            isEsc x = x `mod` 6 == 0++            prsr = P.takeEndByEsc isEsc isSep prsr0++                where++                prsr0 = P.many (P.satisfy (const True)) FL.toList++            escapeSep maybePrevEsc [] =+                case maybePrevEsc of+                    Nothing -> []+                    Just prevEsc -> [prevEsc]+            escapeSep maybePrevEsc (x : xs) =+                 case maybePrevEsc of+                    Nothing ->+                        if isEsc x+                        then escapeSep (Just x) xs+                        else+                            if isSep x+                            then [x]+                            else x : escapeSep Nothing xs+                    Just _ ->+                            x : escapeSep Nothing xs+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list -> checkListEqual parsed_list $ escapeSep Nothing ls+                Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_ :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_ producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let+            isBegin = (== 0)++            isEnd = (== 1)++            isEsc = (== 2)++            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd  FL.toList++            checkPass (x : xs) maybePrevEsc openMinusClose =+                case maybePrevEsc of+                    Nothing ->+                        if isEsc x+                        then checkPass xs (Just x) openMinusClose+                        else+                            if isBegin x+                            then checkPass xs Nothing (openMinusClose + 1)+                            else+                                if isEnd x+                                then+                                    case openMinusClose of+                                        0 -> False+                                        1 -> True+                                        _ ->+                                            checkPass+                                            xs+                                            Nothing+                                            (openMinusClose - 1)+                                else+                                    checkPass xs Nothing openMinusClose+                    Just _ -> checkPass xs Nothing openMinusClose+            checkPass [] _ _ = False++            checkPassBeg [] = False+            checkPassBeg xxs@(x:_)+                | isBegin x = checkPass xxs Nothing (0 :: Int)+                | otherwise = False++            escapeFrame begin end escape l =+                let+                    helper (x : xs) maybePrevEsc openMinusClose =+                        case maybePrevEsc of+                            Nothing ->+                                if escape x+                                then helper xs (Just x) openMinusClose+                                else+                                    if begin x+                                    then helper xs Nothing (openMinusClose + 1)+                                    else+                                        if end x+                                        then+                                            if openMinusClose - 1 == 0+                                            then []+                                            else+                                                helper+                                                xs+                                                Nothing+                                                (openMinusClose - 1)+                                        else+                                            x : helper xs Nothing openMinusClose+                            Just prevEsc ->+                                if escape x || begin x || end x+                                then x : helper xs Nothing openMinusClose+                                else+                                    prevEsc : x : helper xs Nothing openMinusClose+                    helper [] _ _ = error "Cannot Reach Here"+                in+                    helper l Nothing (0 :: Int)+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list ->+                    if checkPassBeg ls+                    then checkListEqual parsed_list $+                        escapeFrame isBegin isEnd isEsc ls+                    else property False+                Left _ ->+                    if checkPassBeg ls+                    then property False+                    else property True++takeFramedByEsc_Pass :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Pass producer consumer =+    forAll (listOf (chooseInt (min_value, max_value))) $ \list ->+        let+            ls = (0 : list) ++ (Prelude.replicate (Prelude.length list + 1) 1)++            isBegin = (== 0)++            isEnd = (== 1)++            isEsc = (== 2)++            prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++            escapeFrame begin end escape l =+                let+                    helper (x : xs) maybePrevEsc openMinusClose =+                        case maybePrevEsc of+                            Nothing ->+                                if escape x+                                then helper xs (Just x) openMinusClose+                                else+                                    if begin x+                                    then+                                        if openMinusClose == 0+                                        then helper xs Nothing (openMinusClose + 1)+                                        else x : helper xs Nothing (openMinusClose + 1)+                                    else+                                        if end x+                                        then+                                            if openMinusClose - 1 == 0+                                            then []+                                            else+                                                x :+                                                helper+                                                xs+                                                Nothing+                                                (openMinusClose - 1)+                                        else+                                            x : helper xs Nothing openMinusClose+                            Just _ ->+                                x : helper xs Nothing openMinusClose+                    helper [] _ _ = error "Cannot Reach Here"+                in+                    helper l Nothing (0 :: Int)+        in+            case runIdentity $ consumer prsr (producer ls) of+                Right parsed_list -> checkListEqual parsed_list $ escapeFrame isBegin isEnd isEsc ls+                _ -> property False++takeFramedByEsc_Fail1 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail1 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame end"++        isBegin = (== 0)++        isEnd = (== 0)++        isEsc = (== 2)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [0 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_Fail2 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail2 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame start"++        isBegin = (== 0)++        isEnd = (== 1)++        isEsc = (== 1)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [1 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeFramedByEsc_Fail3 :: ParserTestCase_Temp Int Identity [Int] Property+takeFramedByEsc_Fail3 producer consumer =+    let+        msg = "takeFramedByEsc_: missing frame end"++        isBegin = (== 2)++        isEnd = (== 1)++        isEsc = (== 2)++        prsr = P.takeFramedByEsc_ isEsc isBegin isEnd FL.toList++        ls = [2 :: Int]+    in+        case runIdentity $ consumer prsr (producer ls) of+            Right _ -> property False+            Left err -> property (msg `isSuffixOf` displayException err)++takeStartBy_ :: ParserTestCase_Temp Int Identity [Int] Property+takeStartBy_ producer consumer =+     forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->+        let ls1 = 1:ls+            msg = "takeFramedByGeneric: empty token"+        in+            case runIdentity $ consumer parser (producer ls1) of+                Right parsed_list ->+                  if not $ Prelude.null ls1+                  then+                    let tls = Prelude.takeWhile (not . predicate) (tail ls1)+                    in checkListEqual parsed_list $+                      if predicate (head ls1)+                      then tls+                      else Prelude.takeWhile (not . predicate) ls1+                  else property $ Prelude.null parsed_list+                Left err -> property (msg `isSuffixOf` displayException err)+            where+                predicate = odd+                parser = P.takeBeginBy_ predicate FL.toList++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++data TestMode+    = TMParserStream+    | TMParserKStreamK+    | TMParserKStreamKChunks+    | TMParserKStreamKChunksGeneric+    deriving (Show)++runParserTC :: (Unbox a, Monad m) => TestMode -> ParserTestCase a m b c -> c+runParserTC tm runner =+    case tm of+        TMParserStream ->+            runner $ \p -> mapMTup S.toList . S.parseBreakPos p . S.fromList+        TMParserKStreamK ->+            runner $ \p ->+                mapMTup K.toList . K.parseBreakPos (PK.toParserK p) . K.fromList+        TMParserKStreamKChunks ->+            runner $ \p ->+                mapMTup+                    (fmap (concatMap A.toList) . K.toList)+                        . A.parseBreakPos (A.toParserK p)+                        . producerChunks A.fromList+        TMParserKStreamKChunksGeneric ->+            runner $ \p ->+                mapMTup+                    (fmap (concatMap GA.toList) . K.toList)+                        . GA.parseBreakPos (GA.toParserK p)+                        . producerChunks GA.fromList++    where+    mapMTup f tupM = do+        (t, a) <- tupM+        (t,) <$> f a++    cSize = 50+    -- Not using A.createOf here because of the MonadIO constraint+    producerChunks fl =+        K.fromStream+             . S.groupsOf cSize (fl <$> FL.toList)+             . S.fromList++runParserTC_temp :: (Unbox a, Monad m) => TestMode -> ParserTestCase_Temp a m b c -> c+runParserTC_temp tm runner =+    case tm of+        TMParserStream -> runner S.fromList S.parsePos+        TMParserKStreamK -> runner K.fromList (K.parsePos . PK.toParserK)+        TMParserKStreamKChunks ->+            runner (producerChunks A.fromList) (A.parsePos . A.toParserK)+        TMParserKStreamKChunksGeneric ->+            runner+                (producerChunks GA.fromList)+                (GA.parsePos . GA.toParserK)++    where+    cSize = 50+    -- Not using A.createOf here because of the MonadIO constraint+    producerChunks fl =+        K.fromStream+             . S.groupsOf cSize (fl <$> FL.toList)+             . S.fromList++{-# NOINLINE mainCommon #-}+mainCommon :: TestMode -> Spec+mainCommon ptt = do+  describe (show ptt) $ do+    describe "Instances" $ do+        prop "applicative" $ runParserTC_temp ptt applicative+        prop "Alternative: end of input 1" $ runParserTC_temp ptt altEOF1+        prop "Alternative: end of input 2" $ runParserTC_temp ptt altEOF2+        prop "monad" $ runParserTC_temp ptt monad+        prop "sequence" $ runParserTC_temp ptt sequence++    describe "test for accumulator" $ do+        prop "P.fromFold FL.sum = FL.sum" $ runParserTC ptt fromFold+        prop "fromPure value provided" $ runParserTC ptt fromPure+        prop "fromPure monadic value provided" $ runParserTC ptt fromEffect+        prop "fail err = Left (SomeException (ParseError err))" $ runParserTC ptt parserFail+        prop "always fail" $ runParserTC ptt die+        prop "always fail but monadic" $ runParserTC ptt dieM++    describe "test for element parser" $ do+        prop "peek = head with list length > 0" $ runParserTC ptt peekPass+        prop "peek fail on []" $ runParserTC ptt peekFail+        prop "eof pass on []" $ runParserTC_temp ptt eofPass+        prop "eof fail on non-empty list" $ runParserTC_temp ptt eofFail+        prop "first element exists and >= mid_value" $ runParserTC_temp ptt satisfyPass+        prop "one pass on [Int]" $ runParserTC_temp ptt onePass+        prop "one fail on []" $ runParserTC_temp ptt one+        prop "check first element exists and satisfies predicate" $ runParserTC_temp ptt satisfy+    describe "test for sequence parser" $ do+        prop "P.takeBetween = Prelude.take when len >= m and len <= n"+            $ runParserTC_temp ptt takeBetweenPass+        prop ("P.takeBetween = Prelude.take when len >= m and len <= n and fail"+              ++ "otherwise fail") $ runParserTC_temp ptt takeBetween+        prop "P.take = Prelude.take" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.take+        prop "P.takeEQ = Prelude.take when len >= n" $ runParserTC_temp ptt takeEQPass+        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise"+            $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeEQ+        prop "P.takeGE n ls = ls when len >= n" $ runParserTC_temp ptt takeGEPass+        prop "P.takeGE n ls = ls when len >= n and fail otherwise" $ runParserTC_temp ptt Streamly.Test.Data.Parser.Common.takeGE+        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" $ runParserTC_temp ptt lookAheadPass+        -- prop "Fail when stream length exceeded" lookAheadFail+        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" $ runParserTC_temp ptt lookAhead+        prop ("P.takeStartBy pred = head : Prelude.takeWhile (not . pred)"+                ++ " tail") $ runParserTC ptt takeStartBy+        prop "P.takeWhile = Prelude.takeWhile" $ runParserTC ptt Streamly.Test.Data.Parser.Common.takeWhile+        prop ("P.takeWhile1 = Prelude.takeWhile if taken something,"+                ++ " else check why failed") $ runParserTC ptt takeWhile1+        prop "takeWhileP prd P.take = takeWhileMaxLen prd" $ runParserTC ptt takeWhileP+        prop ("P.takeP = Prelude.take") $ runParserTC ptt takeP+        prop "P.groupBy = Prelude.head . Prelude.groupBy" $ runParserTC_temp ptt groupBy+        prop "groupByRolling" $ runParserTC_temp ptt groupByRolling+        prop "many (P.wordBy ' ') = words'" $ runParserTC_temp ptt wordBy+        -- prop "choice" choice+        prop "parse 0, then 1, else fail" $ runParserTC_temp ptt splitWith+        prop "fail due to die as left parser" $ runParserTC_temp ptt splitWithFailLeft+        prop "fail due to die as right parser" $ runParserTC_temp ptt splitWithFailRight+        prop "fail due to die as both parsers" $ runParserTC_temp ptt splitWithFailBoth+        -- prop "" teeWithPass+        -- prop "" teeWithFailLeft+        -- prop "" teeWithFailRight+        -- prop "" teeWithFailBoth+        -- prop "deintercalate" deintercalate+        -- prop "" shortestPass+        -- prop "" shortestFailLeft+        -- prop "" shortestFailRight+        -- prop "" shortestFailBoth+        prop ("P.many concatFold $ P.takeEndBy_ (== 1) FL.toList ="+                ++ "Prelude.filter (== 0)") $ runParserTC_temp ptt many+        prop "[] due to parser being die" $ runParserTC_temp ptt many_empty+        prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList ="+                ++ "Prelude.filter (== 0)") $ runParserTC_temp ptt some+        prop "fail due to parser being die" $ runParserTC_temp ptt someFail+        prop "takeEndBy_" $ runParserTC ptt takeEndBy_+        prop "takeEndByOrMax_" $ runParserTC ptt takeEndByOrMax_+        prop "takeEndBy1" $ runParserTC_temp ptt takeEndBy1+        prop "takeEndByEsc" $ runParserTC_temp ptt takeEndByEsc+        prop "takeFramedByEsc_" $ runParserTC_temp ptt takeFramedByEsc_+        prop "takeFramedByEsc_Pass" $ runParserTC_temp ptt takeFramedByEsc_Pass+        prop "takeFramedByEsc_Fail1" $ runParserTC_temp ptt takeFramedByEsc_Fail1+        prop "takeFramedByEsc_Fail2" $ runParserTC_temp ptt takeFramedByEsc_Fail2+        prop "takeFramedByEsc_Fail3" $ runParserTC_temp ptt takeFramedByEsc_Fail3+        prop "takeStartBy_" $ runParserTC_temp ptt takeStartBy_++    runParserTC_temp ptt takeProperties++main :: Spec+main = do+        -- We keep Parser and ParserK tests in the same (Parser) executable for 2+        -- reasons:+        -- 1. We almost always write Parser tests hence we prioritize Parser over+        --    ParserK+        -- 2. This results in minimal compilation overhead compared to duplicating+        --    or keeping the common part in the library.+        --    2.1. Duplication will result in compilation of this code twice+        --    2.2. Keeping the common part in the library will compile the Parser+        --         code even when it's not necessary. For example, if we are running+        --         non-parser test suites.+        --+        -- One problem is that this module becomes very big for compilation. We can+        -- break this further and keep them as a part of "other-modules" in+        -- Test.Parser test-suite.+        mainCommon TMParserStream+        mainCommon TMParserKStreamKChunks+        mainCommon TMParserKStreamK+        mainCommon TMParserKStreamKChunksGeneric
test/Streamly/Test/Data/ParserK.hs view
@@ -5,756 +5,126 @@  module Main (main) where -import Control.Applicative ((<|>))-import Control.Exception (SomeException(..), try)-import Data.Word (Word8, Word32, Word64)-import Streamly.Test.Common (listEquals, checkListEqual, chooseInt)-import Test.Hspec (Spec, hspec, describe)+import Data.Either (fromRight)+import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe) import Test.Hspec.QuickCheck-import Test.QuickCheck-       (arbitrary, forAll, elements, Property,-        property, listOf, vectorOf, (.&&.), Gen)-import Test.QuickCheck.Monadic (monadicIO, assert, run) -import qualified Data.List as List-import qualified Prelude-import qualified Streamly.Data.Stream as S import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array.Generic as AG import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as P-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream as S-import qualified Streamly.Internal.Data.Stream as D-import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.ParserK as ParserK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Test.Hspec as H -import Prelude hiding (sequence)--#if MIN_VERSION_QuickCheck(2,14,0)--import Test.QuickCheck (chooseAny)-import Control.Monad.Identity (runIdentity, Identity (Identity))--#else--import System.Random (Random(random))-import Test.QuickCheck.Gen (Gen(MkGen))---- | Generates a random element over the natural range of `a`.-chooseAny :: Random a => Gen a-chooseAny = MkGen (\r _ -> let (x,_) = random r in x)+import Streamly.Test.Parser.Common -#endif+import Prelude hiding (sequence)  maxTestCount :: Int maxTestCount = 100 -min_value :: Int-min_value = 0--mid_value :: Int-mid_value = 5000--max_value :: Int-max_value = 10000--max_length :: Int-max_length = 1000--toList :: Monad m => S.Stream m a -> m [a]-toList = S.fold FL.toList---- Accumulator Tests--fromFold :: Property-fromFold =-    forAll (listOf $ chooseInt (min_value, max_value))-      $ \ls ->-            case (==) <$> runIdentity (S.parseD (P.fromFold FL.sum) (S.fromList ls))-                   <*> (S.fold FL.sum (S.fromList ls)) of-                Right is_equal -> is_equal-                Left _ -> False--fromPure :: Property-fromPure =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case runIdentity $ S.parseD (P.fromPure x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--fromEffect :: Property-fromEffect =-    forAll (chooseInt (min_value, max_value)) $ \x ->-        case runIdentity $ S.parseD (P.fromEffect $ return x) (S.fromList [1 :: Int]) of-            Right r -> r == x-            Left _ -> False--die :: Property-die =-    property $-    case runIdentity (S.parseD (P.die "die test") (S.fromList [0 :: Int])) of-        Right _ -> False-        Left _ -> True--dieM :: Property-dieM =-    property $-    case runIdentity (S.parseD (P.dieM (Identity "die test")) (S.fromList [0 :: Int])) of-        Right _ -> False-        Left _ -> True---- Element Parser Tests--peekPass :: Property-peekPass =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parseD P.peek (S.fromList ls) of-                Right head_value -> case ls of-                    head_ls : _ -> head_value == head_ls-                    _ -> False-                Left _ -> False--peekFail :: Property-peekFail =-    property (case runIdentity $ S.parseD P.peek (S.fromList []) of-        Right _ -> False-        Left _ -> True)--eofPass :: Property-eofPass =-    property (case S.parseD P.eof (S.fromList []) of-        Right _ -> True-        Left _ -> False)--eofFail :: Property-eofFail =-    forAll (chooseInt (1, max_length)) $ \list_length ->-        forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parseD P.eof (S.fromList ls) of-                Right _ -> False-                Left _ -> True--satisfyPass :: Property-satisfyPass =-    forAll (chooseInt (mid_value, max_value)) $ \first_element ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls_tail ->-            let-                ls = first_element : ls_tail-                predicate = (>= mid_value)-            in-                case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of-                    Right r -> r == first_element-                    Left _ -> False--satisfy :: Property-satisfy =-    forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-        case runIdentity $ S.parseD (P.satisfy predicate) (S.fromList ls) of-            Right r -> case ls of-                [] -> False-                (x : _) -> predicate x && (r == x)-            Left _ -> case ls of-                [] -> True-                (x : _) -> not $ predicate x-        where-            predicate = (>= mid_value)---- Sequence Parsers Tests-takeBetweenPass :: Property-takeBetweenPass =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (m, max_value)) $ \n ->-            forAll (chooseInt (m, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                    case runIdentity $ S.parseD (P.takeBetween m n FL.toList) (S.fromList ls) of-                        Right parsed_list ->-                            let lpl = Prelude.length parsed_list-                            in checkListEqual parsed_list (Prelude.take lpl ls)-                        Left _ -> property False---takeBetween :: Property-takeBetween =-    forAll (chooseInt (min_value, max_value)) $ \m ->-        forAll (chooseInt (min_value, max_value)) $ \n ->-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                let-                    list_length = Prelude.length ls-                in monadicIO $ do-                    let p = P.takeBetween m n FL.toList-                    r <- run $ try $ S.parseD p (S.fromList ls)-                    return $ case r of-                        Right x -> case x of-                            Right parsed_list ->-                                if m <= list_length && n >= m-                                then-                                    let len = Prelude.length parsed_list-                                    in checkListEqual-                                            parsed_list (Prelude.take len ls)-                                else property False-                            Left _ ->-                                property (m > n || list_length < m)-                        Left (_ :: SomeException) ->-                            property (m > n || list_length < m)--take :: Property-take =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            case runIdentity $ S.parseD (P.fromFold $ FL.take n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)-                Left _ -> property False--takeEQPass :: Property-takeEQPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)-                    Left _ -> property False--takeEQ :: Property-takeEQ =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case runIdentity $ S.parseD (P.takeEQ n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if (n <= list_length) then-                            checkListEqual parsed_list (Prelude.take n ls)-                        else-                            property False-                    Left _ -> property (n > list_length)--takeGEPass :: Property-takeGEPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (chooseInt (n, max_value)) $ \list_length ->-            forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list -> checkListEqual parsed_list ls-                    Left _ -> property False--takeGE :: Property-takeGE =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-            let-                list_length = Prelude.length ls-            in-                case runIdentity $ S.parseD (P.takeGE n FL.toList) (S.fromList ls) of-                    Right parsed_list ->-                        if (n <= list_length) then-                            checkListEqual parsed_list ls-                        else-                            property False-                    Left _ -> property (n > list_length)--nLessThanEqual0 ::-       (  Int-       -> FL.Fold Identity Int [Int]-       -> P.Parser Int Identity [Int]-       )-    -> (Int -> [Int] -> [Int])-    -> Property-nLessThanEqual0 tk ltk =-    forAll (elements [0, (-1)]) $ \n ->-        forAll (listOf arbitrary) $ \ls ->-            case runIdentity $ S.parseD (tk n FL.toList) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (ltk n ls)-                Left _ -> property False--takeProperties :: Spec-takeProperties =-    describe "take combinators when n <= 0/" $ do-        prop "takeEQ n FL.toList = []" $-            nLessThanEqual0 P.takeEQ (\_ -> const [])-        prop "takeGE n FL.toList xs = xs" $-            nLessThanEqual0 P.takeGE (\_ -> id)----- XXX lookAhead can't deal with EOF which in this case means when--- n==list_length, this test will fail. So excluding that case for now.-lookAheadPass :: Property-lookAheadPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (chooseInt (n+1, max_value)) $ \list_length ->-                forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->-                    case runIdentity $ S.parseD parseTwice (S.fromList ls) of-                        Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                        Left _ -> property $ False--lookAhead :: Property-lookAhead =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        let-            takeWithoutConsume = P.lookAhead $ P.fromFold $ FL.take n FL.toList-            parseTwice = do-                parsed_list_1 <- takeWithoutConsume-                parsed_list_2 <- takeWithoutConsume-                return (parsed_list_1, parsed_list_2)-        in-            forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->-                case runIdentity $ S.parseD parseTwice (S.fromList ls) of-                    Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)-                    Left _ -> property ((list_length < n) || (list_length == n && n == 0))-                        where-                            list_length = Prelude.length ls--takeWhile :: Property-takeWhile =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case runIdentity $ S.parseD (P.takeWhile predicate FL.toList) (S.fromList ls) of-            Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)-            Left _ -> property False-        where-            predicate = (== 0)--takeWhile1 :: Property-takeWhile1 =-    forAll (listOf (chooseInt (0, 1))) $ \ ls ->-        case runIdentity $ S.parseD (P.takeWhile1 predicate  FL.toList) (S.fromList ls) of-            Right parsed_list -> case ls of-                [] -> property False-                (x : _) ->-                    if predicate x then-                        checkListEqual parsed_list (Prelude.takeWhile predicate ls)-                    else-                        property False-            Left _ -> case ls of-                [] -> property True-                (x : _) -> property (not $ predicate x)-        where-            predicate = (== 0)--groupBy :: Property-groupBy =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case runIdentity $ S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF lst-        | null lst = []-        | otherwise = head $ List.groupBy cmp lst--groupByRolling :: Property-groupByRolling =-    forAll (listOf (chooseInt (0, 1)))-        $ \ls ->-              case runIdentity $ S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (groupByLF Nothing ls)-                  Left _ -> property False--    where--    cmp = (==)-    parser = P.groupBy cmp FL.toList-    groupByLF _ [] = []-    groupByLF Nothing (x:xs) = x : groupByLF (Just x) xs-    groupByLF (Just y) (x:xs) =-        if cmp y x-        then x : groupByLF (Just x) xs-        else []--takeEndByOrMax :: Property-takeEndByOrMax =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (0, 1))) $ \ls ->-            case runIdentity $ S.parseD (P.fromFold $ FL.takeEndBy_ predicate (FL.take n FL.toList)) (S.fromList ls) of-                Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))-                Left _ -> property False-            where-                predicate = (== 1)--wordBy :: Property-wordBy =-    forAll (listOf (elements [' ', 's']))-        $ \ls ->-              case runIdentity $ S.parseD parser (S.fromList ls) of-                  Right parsed -> checkListEqual parsed (words' ls)-                  Left _ -> property False--    where--    predicate = (== ' ')-    parser = P.many (P.wordBy predicate FL.toList) FL.toList-    words' lst =-        let wrds = words lst-         in if wrds == [] && length lst > 0 then [""] else wrds---splitWith :: Property-splitWith =-    forAll (listOf (chooseInt (0, 1))) $ \ls ->-        case runIdentity $ S.parseD (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (S.fromList ls) of-            Right (result_first, result_second) -> case ls of-                0 : 1 : _ -> (result_first == 0) && (result_second == 1)-                _ -> False-            Left _ -> case ls of-                0 : 1 : _ -> False-                _ -> True--splitWithFailLeft :: Property-splitWithFailLeft =-    property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailRight :: Property-splitWithFailRight =-    property (case runIdentity $ S.parseD (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--splitWithFailBoth :: Property-splitWithFailBoth =-    property (case runIdentity $ S.parseD (P.splitWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--{--teeWithPass :: Property-teeWithPass =-    forAll (chooseInt (min_value, max_value)) $ \n ->-        forAll (listOf (chooseInt (0, 1))) $ \ls ->-            let-                prsr = P.fromFold $ FL.take n FL.toList-            in-                case S.parseD (P.teeWith (,) prsr prsr) (S.fromList ls) of-                    Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2-                    Left _ -> property False--teeWithFailLeft :: Property-teeWithFailLeft =-    property (case S.parseD (P.teeWith (,) (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--teeWithFailRight :: Property-teeWithFailRight =-    property (case S.parseD (P.teeWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--teeWithFailBoth :: Property-teeWithFailBoth =-    property (case S.parseD (P.teeWith (,) (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--shortestPass :: Property-shortestPass =-    forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->-        let-            half_mid_value = mid_value `Prelude.div` 2-            prsr_1 = P.takeWhile (<= half_mid_value) FL.toList-            prsr_2 = P.takeWhile (<= mid_value) FL.toList-            prsr_shortest = P.shortest prsr_1 prsr_2-        in-            case S.parseD prsr_shortest (S.fromList ls) of-                Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= half_mid_value) ls)-                Left _ -> property False--shortestPassLeft :: Property-shortestPassLeft =-    property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--shortestPassRight :: Property-shortestPassRight =-    property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--shortestFailBoth :: Property-shortestFailBoth =-    property-        (case S.parseD-                  (P.shortest (P.die "die") (P.die "die"))-                  (S.fromList [1 :: Int]) of-             Right _ -> False-             Left _ -> True)--longestPass :: Property-longestPass =-    forAll (listOf (chooseInt(min_value, max_value))) $ \ls ->-        let-            half_mid_value = mid_value `Prelude.div` 2-            prsr_1 = P.takeWhile (<= half_mid_value) FL.toList-            prsr_2 = P.takeWhile (<= mid_value) FL.toList-            prsr_longest = P.longest prsr_1 prsr_2-        in-            case S.parseD prsr_longest (S.fromList ls) of-                Right long_list -> long_list == Prelude.takeWhile (<= mid_value) ls-                Left _ -> False--longestPassLeft :: Property-longestPassLeft =-    property (case S.parseD (P.shortest (P.die "die") (P.fromPure (1 :: Int))) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--longestPassRight :: Property-longestPassRight =-    property (case S.parseD (P.shortest (P.fromPure (1 :: Int)) (P.die "die")) (S.fromList [1 :: Int]) of-        Right r -> r == 1-        Left _ -> False)--longestFailBoth :: Property-longestFailBoth =-    property-        (case S.parseD (P.shortest (P.die "die") (P.die "die")) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)--}--many :: Property-many =-    forAll (listOf (chooseInt (0, 1)))-      $ \ls ->-            let fldstp conL currL = return $ FL.Partial (conL ++ currL)-                concatFold =-                    FL.Fold fldstp (return (FL.Partial [])) return return-                prsr =-                    flip P.many concatFold-                        $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-             in case runIdentity $ S.parseD prsr (S.fromList ls) of-                    Right res_list ->-                        checkListEqual res_list (Prelude.filter (== 0) ls)-                    Left _ -> property False--many_empty :: Property-many_empty =-    property (case runIdentity $ S.parseD (flip P.many FL.toList (P.die "die")) (S.fromList [1 :: Int]) of-        Right res_list -> checkListEqual res_list ([] :: [Int])-        Left _ -> property False)--some :: Property-some =-    forAll (listOf (chooseInt (0, 1)))-      $ \ls ->-            let fldstp conL currL = return $ FL.Partial $ conL ++ currL-                concatFold = FL.Fold fldstp (return (FL.Partial [])) return return-                prsr =-                    flip P.some concatFold-                        $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList-             in case runIdentity $ S.parseD prsr (S.fromList ls) of-                    Right res_list -> res_list == Prelude.filter (== 0) ls-                    Left _ -> False--someFail :: Property-someFail =-    property (case runIdentity $ S.parseD (P.some (P.die "die") FL.toList) (S.fromList [1 :: Int]) of-        Right _ -> False-        Left _ -> True)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------applicative :: Property-applicative =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            monadicIO $ do-            let parser =-                        (,)-                            <$> P.fromFold (FL.take (length list1) FL.toList)-                            <*> P.fromFold (FL.take (length list2) FL.toList)--            return $-                case runIdentity $ S.parseD parser (S.fromList $ list1 ++ list2) of-                    Right (olist1, olist2) -> olist1 == list1 && olist2 == list2-                    Left _ -> False--sequence :: Property-sequence =-    forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->-        monadicIO $ do-        let parsers = fmap (\xs -> P.fromFold $ FL.take (length xs) FL.toList) ins-        outs <- S.parseD-                    (Prelude.sequence parsers)-                    (S.fromList $ concat ins)-        return $-            case outs of-                Right x -> x == ins-                Left _ -> False--altEOF1 :: Property-altEOF1 =-    monadicIO $ do-    s1 <- S.parseD-        (P.satisfy (> 0) <|> return 66)-        (S.fromList ([]::[Int]))-    return $-        case s1 of-            Right x -> x == 66-            Left _ -> False--altEOF2 :: Property-altEOF2 =-    monadicIO $ do-    s1 <- S.parseD-        ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList))-        (S.fromList ([51]::[Int]))-    return $-        case s1 of-            Right x -> x == [51]-            Left _ -> False--monad :: Property-monad =-    forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->-        forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->-            monadicIO $ do-            let parser = do-                            olist1 <- P.fromFold (FL.take (length list1) FL.toList)-                            olist2 <- P.fromFold (FL.take (length list2) FL.toList)-                            return (olist1, olist2)-            s1 <- S.parseD parser (S.fromList $ list1 ++ list2)-            return $-                case s1 of-                Right (olist1, olist2) -> olist1 == list1 && olist2 == list2-                Left _ -> False+toParser :: Spec+toParser = do+    let p = ParserK.toParser (ParserK.toParserK Parser.one)+        runP xs = Stream.parsePos p (Stream.fromList xs)+    describe "toParser . toParserK" $ do+        it "empty stream" $ do+            r1 <- runP ([] :: [Int])+            case r1 of+                Left e -> print e+                Right x ->+                    expectationFailure $ "Expecting failure, got: " ++ show x+        it "exact stream" $ do+            r2 <- runP [0::Int]+            fromRight undefined r2 `shouldBe` 0+        it "longer stream" $ do+            r3 <- runP [0,1::Int]+            fromRight undefined r3 `shouldBe` 0 ----------------------------------------------------------------------------------- Stream parsing--------------------------------------------------------------------------------+    let p1 = ParserK.toParserK $ ParserK.toParser (ParserK.toParserK Parser.one)+        runP1 xs = StreamK.parsePos p1 (StreamK.fromStream $ Stream.fromList xs)+    describe "toParserK . toParser . toParserK" $ do+        it "empty stream" $ do+            r1 <- runP1 ([] :: [Int])+            case r1 of+                Left e -> print e+                Right x ->+                    expectationFailure $ "Expecting failure, got: " ++ show x+        it "exact stream" $ do+            r2 <- runP1 [0::Int]+            fromRight undefined r2 `shouldBe` 0+        it "longer stream" $ do+            r3 <- runP1 [0,1::Int]+            fromRight undefined r3 `shouldBe` 0 -parseMany :: Property-parseMany =-    forAll (chooseInt (1,100)) $ \len ->-        forAll (listOf (vectorOf len (chooseAny :: Gen Int))) $ \ ins ->-            monadicIO $ do-            outs <--                (toList $ S.catRights $ S.parseManyD-                    (P.fromFold $ FL.take len FL.toList) (S.fromList $ concat ins)-                )-            return $ outs == ins+    -- NOTE: Without fusionBreaker this test would pass even if toParser has+    -- incorrect implementation because of fusion rules.+    let p2 = Parser.takeWhile (<= 3) FL.toList+        runP2 xs = Stream.parseBreakPos p2 (Stream.fromList xs) --- basic sanity test for parsing from arrays-parseUnfold :: Property-parseUnfold = do-    let len = 200-    -- ls = input list (stream)-    -- clen = chunk size-    -- tlen = parser take size-    forAll-        ((,,)-            <$> vectorOf len (chooseAny :: Gen Int)-            <*> chooseInt (1, len)-            <*> chooseInt (1, len)) $ \(ls, clen, tlen) ->-        monadicIO $ do-            arrays <- toList $ S.chunksOf clen (S.fromList ls)-            let src = Producer.source (Just (Producer.OuterLoop arrays))-            let parser = P.fromFold (FL.take tlen FL.toList)-            let readSrc =-                    Producer.producer-                        $ Producer.concat Producer.fromList A.producer-            let streamParser =-                    Producer.simplify (Producer.parseManyD parser readSrc)-            xs <- run-                $ toList-                $ S.unfoldMany Unfold.fromList-                $ S.catRights-                $ S.unfold streamParser src+        p3 = ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList)+        runP3 xs = StreamK.parseBreakPos p3 (StreamK.fromList xs) -            listEquals (==) xs ls+        p4 =+            ParserK.toParser+                $ fusionBreaker+                $ ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList)+        runP4 xs = Stream.parseBreakPos p4 (Stream.fromList xs)+    describe "toParser . toParserK" $ do+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP2 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- Stream.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP3 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- StreamK.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3, 4, 5]" $ do+            (a, b) <- runP4 ([1, 2, 3, 4, 5] :: [Int])+            fromRight undefined a `shouldBe` [1,2,3]+            rest <- Stream.toList b+            rest `shouldBe` [4, 5]+        it "(<= 3) for [1, 2, 3]" $ do+            (a, b) <- runP4 ([1, 2, 3] :: [Int])+            fromRight undefined a `shouldBe` [1, 2, 3]+            rest <- Stream.toList b+            rest `shouldBe` [] -parserSequence :: Property-parserSequence =-  forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins ->-    monadicIO $ do-    let parsers = D.fromList-            $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins-    let sequencedParser = P.sequence parsers FL.sum-    outs <--        S.parseD sequencedParser $ S.concatMap S.fromList (S.fromList ins)-    return $-        case outs of-            Right x -> x == sum (map sum ins)-            Left _ -> False+{-# NOINLINE fusionBreaker #-}+fusionBreaker :: a -> a+fusionBreaker = id  ---------------------------------------------------------------------------------- Test for a particular case hit during fs events testing+-- Parser driver sanity tests ------------------------------------------------------------------------------- -evId :: [Word8]-evId = [96,238,17,9,0,0,0,0]--evFlags :: [Word8]-evFlags = [0,4,1,0,0,0,0,0]--evPathLen :: [Word8]-evPathLen = [71,0,0,0,0,0,0,0]--evPath :: [Word8]-evPath =-    [47,85,115,101,114,115,47,118,111,108,47,118,101,109,98,97,47,99,111,109-    ,112,111,115,101,119,101 ,108,108,45,116,101,99,104,47,69,110,103,47,112-    ,114,111,106,101,99,116,115,47,115,116,114,101,97,109,108,121,47,115,116-    ,114,101,97,109,108,121,47,116,109,112,47,122,122-    ]--event :: [Word8]-event = evId ++ evFlags ++ evPathLen ++ evPath--data Event = Event-   { eventId :: Word64-   , eventFlags :: Word32-   , eventAbsPath :: A.Array Word8-   } deriving (Show, Ord, Eq)+sanityParseBreak :: [Move] -> H.SpecWith ()+sanityParseBreak jumps = it (show jumps) $ do+    (val, rest) <-+        StreamK.parseBreakPos (ParserK.toParserK (jumpParser jumps))+            $ StreamK.fromList tape+    lst <- StreamK.toList rest+    (val, lst) `shouldBe` (expectedResult jumps tape) -readOneEvent :: P.Parser Word8 IO Event-readOneEvent = do-    arr <- P.takeEQ 24 (A.writeN 24)-    let arr1 = A.castUnsafe arr :: A.Array Word64-        eid = A.getIndexUnsafe 0 arr1-        eflags = A.getIndexUnsafe 1 arr1-        pathLen = fromIntegral $ A.getIndexUnsafe 2 arr1-    path <- P.takeEQ pathLen (A.writeN pathLen)-    return $ Event-        { eventId = eid-        , eventFlags = fromIntegral eflags-        , eventAbsPath = path-        }+sanityParseBreakChunks :: [Move] -> H.SpecWith ()+sanityParseBreakChunks jumps = it (show jumps) $ do+    (val, rest) <-+        A.parseBreakPos (A.toParserK (jumpParser jumps))+            $ StreamK.fromList $ Prelude.map A.fromList chunkedTape+    lst <- Prelude.map A.toList <$> StreamK.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape) -parseMany2Events :: Property-parseMany2Events =-    monadicIO $ do-        xs <--            ( run-            $ toList-            $ S.catRights-            $ S.parseManyD readOneEvent-            $ S.fromList (concat (replicate 2 event))-            )-        assert (length xs == 2)-        -- XXX assuming little endian machine-        let ev = Event-                { eventId = 152170080-                , eventFlags = 66560-                , eventAbsPath = A.fromList evPath-                }-         in listEquals (==) xs (replicate 2 ev)+sanityParseBreakChunksGeneric :: [Move] -> H.SpecWith ()+sanityParseBreakChunksGeneric jumps = it (show jumps) $ do+    (val, rest) <-+        AG.parseBreakPos (AG.toParserK (jumpParser jumps))+            $ StreamK.fromList $ Prelude.map AG.fromList chunkedTape+    lst <- Prelude.map AG.toList <$> StreamK.toList rest+    (val, concat lst) `shouldBe` (expectedResult jumps tape)  ------------------------------------------------------------------------------- -- Main@@ -763,79 +133,14 @@ moduleName :: String moduleName = "Data.ParserK" +-- Many ParserK tests are tested in Test.Parser module main :: IO () main =   hspec $   H.parallel $   modifyMaxSuccess (const maxTestCount) $ do   describe moduleName $ do--    describe "Instances" $ do-        prop "applicative" applicative-        prop "Alternative: end of input 1" altEOF1-        prop "Alternative: end of input 2" altEOF2-        prop "monad" monad-        prop "sequence" sequence--    describe "Stream parsing" $ do-        prop "parseMany" parseMany-        prop "parseMany2Events" parseMany2Events-        prop "parseUnfold" parseUnfold-        prop "parserSequence" parserSequence--    describe "test for accumulator" $ do-        prop "P.fromFold FL.sum = FL.sum" fromFold-        prop "fromPure value provided" fromPure-        prop "fromPure monadic value provided" fromEffect-        prop "always fail" die-        prop "always fail but monadic" dieM--    describe "test for element parser" $ do-        prop "peek = head with list length > 0" peekPass-        prop "peek fail on []" peekFail-        prop "eof pass on []" eofPass-        prop "eof fail on non-empty list" eofFail-        prop "first element exists and >= mid_value" satisfyPass-        prop "check first element exists and satisfies predicate" satisfy--    describe "test for sequence parser" $ do-        prop "P.takeBetween m n = Prelude.take when len >= m and len <= n"-                takeBetweenPass-        prop ("P.takeBetween m n = Prelude.take when len >= m and len <= n and"-            ++ " fail otherwise") takeBetween-        prop "P.take = Prelude.take" Main.take-        prop "P.takeEQ = Prelude.take when len >= n" takeEQPass-        prop "P.takeEQ = Prelude.take when len >= n and fail otherwise" Main.takeEQ-        prop "P.takeGE n ls = ls when len >= n" takeGEPass-        prop "P.takeGE n ls = ls when len >= n and fail otherwise" Main.takeGE-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n" lookAheadPass-        prop "lookAhead . take n >> lookAhead . take n = lookAhead . take n, else fail" lookAhead-        prop "P.takeWhile = Prelude.takeWhile" Main.takeWhile-        prop "P.takeWhile1 = Prelude.takeWhile if taken something, else check why failed" takeWhile1-        prop "P.groupBy = Prelude.head . Prelude.groupBy" groupBy-        prop "groupByRolling" groupByRolling-        prop "P.takeEndByOrMax = Prelude.take n (Prelude.takeWhile (not . predicate)" takeEndByOrMax-        prop "many (P.wordBy ' ') = words'" wordBy-        prop "parse 0, then 1, else fail" splitWith-        prop "fail due to die as left parser" splitWithFailLeft-        prop "fail due to die as right parser" splitWithFailRight-        prop "fail due to die as both parsers" splitWithFailBoth-        {--        prop "parsed two lists should be equal" teeWithPass-        prop "fail due to die as left parser" teeWithFailLeft-        prop "fail due to die as right parser" teeWithFailRight-        prop "fail due to die as both parsers" teeWithFailBoth-        prop "P.takeWhile (<= half_mid_value) = Prelude.takeWhile half_mid_value" shortestPass-        prop "pass even if die is left parser" shortestPassLeft-        prop "pass even if die is right parser" shortestPassRight-        prop "fail due to die as both parsers" shortestFailBoth-        prop "P.takeWhile (<= mid_value) = Prelude.takeWhile (<= mid_value)" longestPass-        prop "pass even if die is left parser" longestPassLeft-        prop "pass even if die is right parser" longestPassRight-        prop "fail due to die as both parsers" longestFailBoth-        -}-        prop "P.many concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" many-        prop "[] due to parser being die" many_empty-        prop "P.some concatFold $ P.takeEndBy_ (== 1) FL.toList = Prelude.filter (== 0)" some-        prop "fail due to parser being die" someFail-    takeProperties+    parserSanityTests "StreamK.parseBreak" sanityParseBreak+    parserSanityTests "StreamK.parseBreakChunks" sanityParseBreakChunks+    parserSanityTests "StreamK.parseBreakChunksGeneric" sanityParseBreakChunksGeneric+    toParser
− test/Streamly/Test/Data/Ring/Unboxed.hs 
@@ -1,53 +0,0 @@--- |--- Module      : Streamly.Test.Data.Ring.Unboxed--- Copyright   : (c) 2022 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Test.Data.Ring.Unboxed (main) where--import Control.Monad (void)--import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Ring as Ring--import Prelude as P-import qualified Data.Foldable as P--import Test.Hspec as H--unsafeEqArrayN :: [Int] -> [Int] -> Int -> Int -> Bool -> IO ()-unsafeEqArrayN lstArr lstRing startR nelem expected = do-    let arr = Array.fromList lstArr-    (ring, rh) <- Ring.new (length lstRing)-    void $ P.foldlM (Ring.unsafeInsert ring) rh lstRing-    Ring.unsafeEqArrayN ring (Ring.moveBy startR ring rh) arr nelem-        `shouldBe` expected--unsafeEqArray :: [Int] -> [Int] -> Int -> Bool -> IO ()-unsafeEqArray lstArr lstRing startR expected = do-    let arr = Array.fromList lstArr-    (ring, rh) <- Ring.new (length lstRing)-    void $ P.foldlM (Ring.unsafeInsert ring) rh lstRing-    Ring.unsafeEqArray ring (Ring.moveBy startR ring rh) arr-        `shouldBe` expected--moduleName :: String-moduleName = "Data.Ring.Unboxed"--main :: IO ()-main = hspec $ do-    describe moduleName $ do-        describe "Eq" $ do-            let lstArr = [0..99]-                lstRing = [50..99] ++ [0..49]-            it "unsafeEqArrayN True (n < len)"-                   $ unsafeEqArrayN lstArr lstRing 50 75 True-            it "unsafeEqArrayN True (n > len)"-                   $ unsafeEqArrayN lstArr lstRing 50 200 True-            it "unsafeEqArrayN False"-                   $ unsafeEqArrayN lstArr lstRing 10 75 False-            it "unsafeEqArray True" $ unsafeEqArray lstArr lstRing 50 True-            it "unsafeEqArray False" $ unsafeEqArray lstArr lstRing 20 False
+ test/Streamly/Test/Data/RingArray.hs view
@@ -0,0 +1,56 @@+-- |+-- Module      : Streamly.Test.Data.RingArray+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.RingArray (main) where++import Streamly.Test.Common (performGCSweep)++import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.RingArray as RingArray++import Prelude as P+import Test.Hspec as H++eqArrayN :: [Int] -> [Int] -> Int -> Int -> Bool -> IO ()+eqArrayN lstArr lstRing startR nBytes expected = do+    let arr = Array.fromList lstArr+    marr <- MutArray.fromList lstRing+    let ring =+            maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr+    performGCSweep 4 100000+    res <- RingArray.eqArrayN ring arr nBytes+    res `shouldBe` expected++eqArray :: [Int] -> [Int] -> Int -> Bool -> IO ()+eqArray lstArr lstRing startR expected = do+    let arr = Array.fromList lstArr+    marr <- MutArray.fromList lstRing+    let ring =+            maybe (error "cast failed") id $ RingArray.castMutArrayWith startR marr+    performGCSweep 4 100000+    res <- RingArray.eqArray ring arr+    res `shouldBe` expected++moduleName :: String+moduleName = "Data.RingArray"++main :: IO ()+main = hspec $ do+    describe moduleName $ do+        describe "Eq" $ do+            let lstArr = [0..99]+                lstRing = [50..99] ++ [0..49]+            it "eqArrayN True (n < len)"+                   $ eqArrayN lstArr lstRing 50 75 True+            it "eqArrayN True (n > len)"+                   $ eqArrayN lstArr lstRing 50 200 True+            it "eqArrayN False"+                   $ eqArrayN lstArr lstRing 10 75 False+            it "eqArray True" $ eqArray lstArr lstRing 50 True+            it "eqArray False" $ eqArray lstArr lstRing 20 False
+ test/Streamly/Test/Data/Scanl/Concurrent.hs view
@@ -0,0 +1,120 @@+-- |+-- Module      : Streamly.Test.Data.Scanl.Concurrent+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Scanl.Concurrent (main) where++import Control.Concurrent (threadDelay)+import Data.Function ( (&) )+import Data.IORef (newIORef, atomicModifyIORef')+import Data.List (sort)+import Streamly.Data.Scanl (Scanl)+import Test.Hspec as H++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Scanl as Scanl+import qualified Streamly.Internal.Data.Scanl.Prelude as Scanl++moduleName :: String+moduleName = "Data.Scanl.Concurrent"++---------------------------------------------------------------------------+-- Main+---------------------------------------------------------------------------++evenScan :: Scanl IO Int (Maybe Int)+evenScan =+    Scanl.filtering even+        & Scanl.lmapM (\x -> threadDelay 100 >> pure x)++oddScan :: Scanl IO Int (Maybe Int)+oddScan =+    Scanl.filtering odd+        & Scanl.lmapM (\x -> threadDelay 100 >> pure x)++parDistributeScan_ScanEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDistributeScan_ScanEnd concOpts = do+    let streamLen = 10000+        evenLen = 100+    ref <- newIORef [Scanl.take evenLen evenScan, oddScan]+    let gen = atomicModifyIORef' ref (\xs -> ([], xs))+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res1 <-+        Scanl.parDistributeScanM concOpts gen inpStream+            & Stream.concatMap Stream.fromList+            & Stream.catMaybes+            & Stream.fold Fold.toList+    sort res1 `shouldBe` [1..evenLen] ++ filter odd [(evenLen+1)..streamLen]++parDemuxScan_ScanEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDemuxScan_ScanEnd concOpts = do+    let streamLen = 10000+        evenLen = 100+        demuxer i = even (i :: Int)+    ref <- newIORef (Scanl.take evenLen $ Scanl.mkScanl1 (\_ x -> x))+    let gen True =+            atomicModifyIORef' ref (\xs -> (fmap (const Nothing) Scanl.drain, xs))+        gen False = pure $ Scanl.mkScanl1 (\_ x -> x)+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res <-+        Scanl.parDemuxScanM concOpts demuxer gen inpStream+            & Stream.concatMap Stream.fromList+            & fmap (\x -> (fst x,) <$> snd x)+            & Stream.catMaybes+            & Stream.fold Fold.toList+    map snd (filter fst res) `shouldBe` take evenLen [2, 4 ..]+    map snd (filter (not . fst) res) `shouldBe` filter odd [1..streamLen]++parDistributeScan_StreamEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDistributeScan_StreamEnd concOpts = do+    let streamLen = 10000+    ref <- newIORef [evenScan, oddScan]+    let gen = atomicModifyIORef' ref (\xs -> ([], xs))+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res1 <-+        Scanl.parDistributeScanM concOpts gen inpStream+            & Stream.concatMap Stream.fromList+            & Stream.catMaybes+            & Stream.fold Fold.toList+    sort res1 `shouldBe` inpList++parDemuxScan_StreamEnd :: (Scanl.Config -> Scanl.Config) -> IO ()+parDemuxScan_StreamEnd concOpts = do+    let streamLen = 10000+        demuxer i = even (i :: Int)+        gen _ = pure $ Scanl.mkScanl1 (\_ x -> x)+        inpList = [1..streamLen]+        inpStream = Stream.fromList inpList+    res <-+        Scanl.parDemuxScanM concOpts demuxer gen inpStream+            & Stream.concatMap Stream.fromList+            & fmap (\x -> (fst x,) <$> snd x)+            & Stream.catMaybes+            & Stream.fold Fold.toList+    map snd (filter fst res) `shouldBe` filter even [1..streamLen]+    map snd (filter (not . fst) res) `shouldBe` filter odd [1..streamLen]++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+        it "parDistributeScanM (stream end) (maxBuffer 1)"+            $ parDistributeScan_StreamEnd (Scanl.maxBuffer 1)+        it "parDistributeScanM (scan end) (maxBuffer 1)"+            $ parDistributeScan_ScanEnd (Scanl.maxBuffer 1)+        it "parDemuxScanM (stream end) (maxBuffer 1)"+            $ parDemuxScan_StreamEnd (Scanl.maxBuffer 1)+        it "parDemuxScanM (scan end) (maxBuffer 1)"+            $ parDemuxScan_ScanEnd (Scanl.maxBuffer 1)
test/Streamly/Test/Data/Serialize.hs view
@@ -32,6 +32,7 @@ import Data.Functor.Identity (Identity (..))  import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray as MutArray import qualified Streamly.Internal.Data.MutByteArray as Serialize  import qualified Streamly.Test.Data.Serialize.CompatV0 as CompatV0@@ -207,9 +208,10 @@     val2 `shouldBe` val     off2 `shouldBe` serEndOff     let slice = Array.Array arr serStartOff serEndOff-    val `shouldBe` Array.deserialize slice-    clonedSlice <- Array.clone slice-    val `shouldBe` Array.deserialize clonedSlice+    val `shouldBe` fst (Array.deserialize slice)+    clonedSlice <-+        fmap Array.unsafeFreeze $ MutArray.clone $ Array.unsafeThaw slice+    val `shouldBe` fst (Array.deserialize clonedSlice)  roundtrip     :: forall a. (Eq a, Show a, Serialize.Serialize a)@@ -221,7 +223,7 @@     -- let sz = Serialize.addSizeTo 0 val     -- putStrLn $ "Size is: " ++ show sz -    val `shouldBe` Array.deserialize (Array.pinnedSerialize val)+    val `shouldBe` fst (Array.deserialize (Array.serialize' val))      res <- poke val     peekAndVerify res val
test/Streamly/Test/Data/Stream.hs view
@@ -1,3 +1,9 @@+-- XXX We are using head/tail at one place+{-# OPTIONS_GHC -Wno-missing-signatures #-}+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif+ -- | -- Module      : Streamly.Test.Data.Stream -- Copyright   : (c) 2019 Composewell technologies@@ -8,26 +14,854 @@  module Streamly.Test.Data.Stream (main) where -import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Data.Stream as Stream+import Control.Monad ( forM_ )+import Control.Monad.IO.Class (MonadIO)+import Data.List (sort, group, intercalate)+import Data.Semigroup (Sum(..), getSum)+import Data.Word (Word8)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Fold (Fold)+import Streamly.Internal.Data.MutByteArray (Unbox)+import Streamly.Internal.Data.Stream (Stream)+import Test.QuickCheck+    ( Gen+    , Property+    , Arbitrary(..)+    , choose+    , forAll+    , frequency+    , listOf+    , listOf1+    , suchThat+    , vectorOf+    , withMaxSuccess+    )+import Test.QuickCheck.Monadic (assert, monadicIO, pick, run) -import Test.Hspec.QuickCheck+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Unfold as Unfold+import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.Parser as Parser+ import Test.Hspec as H+import Test.Hspec.QuickCheck -moduleName :: String-moduleName = "Data.Stream"+import Streamly.Test.Common+-- import Streamly.Test.Prelude.Common +toList :: Monad m => Stream m a -> m [a]+toList = Stream.toList++-- XXX There are takeEndBy_ tests in Data.Fold module as well, need to+-- deduplicate.+-- XXX Where are the tests for "takeEndBy"?+splitOn :: Monad m =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOn predicate f = Stream.foldManyPost (Fold.takeEndBy_ predicate f)++splitOnSuffix :: Monad m =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffix predicate f = Stream.foldMany (Fold.takeEndBy_ predicate f)++-- XXX Where are the tests for "takeEndBySeq"?+splitOnSeqFold :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSeqFold patt f = Stream.foldManyPost (Fold.takeEndBySeq_ patt f)++splitOnSeqStream :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSeqStream = Stream.splitSepBySeq_++splitOnSuffixSeqFold :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffixSeqFold patt f = Stream.foldMany (Fold.takeEndBySeq_ patt f)++-- XXX Where are the tests for Stream.splitOnSuffixSeq True ?+splitOnSuffixSeqStream :: (MonadIO m, Unbox a, Enum a, Eq a) =>+   Array.Array a -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffixSeqStream = Stream.splitOnSuffixSeq False++groupsBy :: Monad m =>+    (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+groupsBy cmp f m = Stream.catRights $ Stream.parseMany (Parser.groupBy cmp f) m++groupsByRolling :: Monad m =>+    (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+groupsByRolling cmp f m =+   Stream.catRights $ Stream.parseMany (Parser.groupByRolling cmp f) m++{-+drainWhile :: Monad m => (a -> Bool) -> Stream m a -> m ()+drainWhile p m = Stream.fold Fold.drain $ Stream.takeWhile p m+-}++splitOnSeq ::+    (Array Char -> Fold IO a [a] -> Stream IO Char -> Stream IO String)+    -> Spec+splitOnSeq op = do+    describe "Tests for splitOnSeq" $ do+        -- Empty pattern case+        it "splitOnSeq_ \"\" \"\" = []"+          $ splitOnSeq_ "" "" `shouldReturn` []++        -- Single element pattern cases+        it "splitOnSeq_ \"x\" \"\" = []"+          $ splitOnSeq_ "x" "" `shouldReturn` []+        it "splitOnSeq_ \"x\" \"hello\" = [\"hello\"]"+          $ splitOnSeq_ "x" "hello" `shouldReturn` ["hello"]+        it "splitOnSeq_ \"h\" \"hello\" = [\"\", \"ello\"]"+          $ splitOnSeq_ "h" "hello" `shouldReturn` ["", "ello"]+        it "splitOnSeq_ \"e\" \"hello\" = [\"h\", \"llo\"]"+          $ splitOnSeq_ "e" "hello" `shouldReturn` ["h", "llo"]+        it "splitOnSeq_ \"l\" \"hello\" = [\"he\", \"\", \"o\"]"+          $ splitOnSeq_ "l" "hello" `shouldReturn` ["he", "", "o"]+        it "splitOnSeq_ \"o\" \"hello\" = [\"hell\", \"\"]"+          $ splitOnSeq_ "o" "hello" `shouldReturn` ["hell", ""]++        -- multi-element pattern fitting in a Word+        it "splitOnSeq_ \"he\" \"\" = []"+          $ splitOnSeq_ "he" "" `shouldReturn` []+        it "splitOnSeq_ \"he\" \"hello\" = [\"\", \"llo\"]"+          $ splitOnSeq_ "he" "hello" `shouldReturn` ["", "llo"]+        it "splitOnSeq_ \"ll\" \"hello\" = [\"he\", \"o\"]"+          $ splitOnSeq_ "ll" "hello" `shouldReturn` ["he", "o"]+        it "splitOnSeq_ \"lo\" \"hello\" = [\"hel\", \"\"]"+          $ splitOnSeq_ "lo" "hello" `shouldReturn` ["hel", ""]++        -- multi-element pattern - Rabin-Karp cases+        it "splitOnSeq_ \"hello\" \"\" = []"+          $ splitOnSeq_ "hello" "" `shouldReturn` []+        it "splitOnSeq_ \"hel\" \"hello\" = [\"\", \"lo\"]"+          $ splitOnSeq_ "hel" "hello" `shouldReturn` ["", "lo"]+        it "splitOnSeq_ \"ell\" \"hello\" = [\"h\", \"o\"]"+          $ splitOnSeq_ "ell" "hello" `shouldReturn` ["h", "o"]+        it "splitOnSeq_ \"llo\" \"hello\" = [\"he\", \"\"]"+          $ splitOnSeq_ "llo" "hello" `shouldReturn` ["he", ""]+        it "splitOnSeq_ \"hello\" \"hello\" = [\"\", \"\"]"+          $ splitOnSeq_ "hello" "hello" `shouldReturn` ["", ""]++    where++    splitOnSeq_ pat xs = toList $+        op (Array.fromList pat) Fold.toList (Stream.fromList xs)++splitOnSuffixSeq ::+    (Array Char -> Fold IO a [a] -> Stream IO Char -> Stream IO String)+    -> Spec+splitOnSuffixSeq op = do+    describe "Tests for splitOnSuffixSeq" $ do+        -- Empty pattern case++        -- Single element pattern cases+        it "splitSuffixOn_ \".\" \"\" []"+          $ splitSuffixOn_ "." "" `shouldReturn` []+        it "splitSuffixOn_ \".\" \".\" [\"\"]"+          $ splitSuffixOn_ "." "." `shouldReturn` [""]+        it "splitSuffixOn_ \".\" \"a\" [\"a\"]"+          $ splitSuffixOn_ "." "a" `shouldReturn` ["a"]+        it "splitSuffixOn_ \".\" \".a\" [\"\",\"a\"]"+          $ splitSuffixOn_ "." ".a" `shouldReturn` ["", "a"]+        it "splitSuffixOn_ \".\" \"a.\" [\"a\"]"+          $ splitSuffixOn_ "." "a." `shouldReturn` ["a"]+        it "splitSuffixOn_ \".\" \"a.b\" [\"a\",\"b\"]"+          $ splitSuffixOn_ "." "a.b" `shouldReturn` ["a", "b"]+        it "splitSuffixOn_ \".\" \"a.b.\" [\"a\",\"b\"]"+          $ splitSuffixOn_ "." "a.b." `shouldReturn` ["a", "b"]+        it "splitSuffixOn_ \".\" \"a..b..\" [\"a\",\"\",\"b\",\"\"]"+          $ splitSuffixOn_ "." "a..b.." `shouldReturn` ["a", "", "b", ""]++        -- multi-element pattern fitting in a Word+        it "splitSuffixOn_ \"he\" \"hello\" = [\"\", \"llo\"]"+          $ splitSuffixOn_ "he" "hello" `shouldReturn` ["", "llo"]+        it "splitSuffixOn_ \"el\" \"hello\" = [\"h\", \"lo\"]"+          $ splitSuffixOn_ "el" "hello" `shouldReturn` ["h", "lo"]+        it "splitSuffixOn_ \"lo\" \"hello\" = [\"hel\"]"+          $ splitSuffixOn_ "lo" "hello" `shouldReturn` ["hel"]++        -- multi-element pattern - Rabin-Karp cases+        it "splitSuffixOn_ \"hello\" \"\" = []"+          $ splitSuffixOn_ "hello" "" `shouldReturn` []+        it "splitSuffixOn_ \"hel\" \"hello\" = [\"\", \"lo\"]"+          $ splitSuffixOn_ "hel" "hello" `shouldReturn` ["", "lo"]+        it "splitSuffixOn_ \"ell\" \"hello\" = [\"h\", \"o\"]"+          $ splitSuffixOn_ "ell" "hello" `shouldReturn` ["h", "o"]+        it "splitSuffixOn_ \"llo\" \"hello\" = [\"he\"]"+          $ splitSuffixOn_ "llo" "hello" `shouldReturn` ["he"]+        it "splitSuffixOn_ \"hello\" \"hello\" = [\"\", \"\"]"+          $ splitSuffixOn_ "hello" "hello" `shouldReturn` [""]++    where++    splitSuffixOn_ pat xs = toList $+        op (Array.fromList pat) Fold.toList (Stream.fromList xs)++intercalateSuffix xs yss = intercalate xs yss ++ xs++nonSepElem :: (Arbitrary a, Eq a) => a -> Gen a+nonSepElem sep = suchThat arbitrary (/= sep)++listWithSep :: Arbitrary a => a -> Gen [a]+listWithSep sep = listOf $ frequency [(3, arbitrary), (1, return sep)]++listWithoutSep :: (Arbitrary a, Eq a) => a -> Gen [a]+listWithoutSep sep = vectorOf 4 (nonSepElem sep)++listsWithoutSep :: (Arbitrary a, Eq a) => a -> Gen [[a]]+listsWithoutSep sep = listOf (listWithoutSep sep)++listsWithoutSep1 :: (Arbitrary a, Eq a) => a -> Gen [[a]]+listsWithoutSep1 sep = listOf1 (listWithoutSep sep)++intercalateSplitEqId sep splitter lIntercalater sIntercalater i =+    let name =+            "intercalater . splitter == id ("+                <> show i <> " element separator)"+     in prop name+            $ forAll (listWithSep sep)+            $ \xs -> withMaxSuccess maxTestCount $ monadicIO $ testCase xs++    where++    testCase xs = do+        ys <- splitter xs (replicate i sep)+        szs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList ys+        let lzs = lIntercalater (replicate i sep) ys+        listEquals (==) szs xs+        listEquals (==) lzs xs++intercalateSplitEqIdNoSepEnd sep splitter lIntercalater sIntercalater i =+    let name =+            "intercalater . splitter . (++ [x \\= sep]) == id ("+                <> show i <> " element separator)"+     in prop name+            $ forAll ((,) <$> listWithSep sep <*> nonSepElem sep)+            $ \(xs_, nonSep) -> do+                  let xs = xs_ ++ [nonSep]+                  withMaxSuccess maxTestCount $ monadicIO $ testCase xs++    where++    testCase xs = do+        ys <- splitter xs (replicate i sep)+        szs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList ys+        let lzs = lIntercalater (replicate i sep) ys+        listEquals (==) szs xs+        listEquals (==) lzs xs++concatSplitIntercalateEqConcat sep splitter lIntercalater sIntercalater i =+    let name =+            "concat . splitter .Stream.intercalater == "+                <> "concat ("+                <> show i <> " element separator/possibly empty list)"+     in prop name+            $ forAll (listsWithoutSep sep)+            $ \xss -> withMaxSuccess maxTestCount $ monadicIO $ testCase xss++    where++    testCase xss = do+        let lxs = lIntercalater (replicate i sep) xss+        lys <- splitter lxs (replicate i sep)+        sxs <-+            toList+                $ sIntercalater (replicate i sep) Unfold.fromList+                $ Stream.fromList xss+        sys <- splitter sxs (replicate i sep)+        listEquals (==) (concat lys) (concat xss)+        listEquals (==) (concat sys) (concat xss)++splitIntercalateEqId sep splitter lIntercalater sIntercalater =+    let name =+            "splitter . intercalater == id"+                <> " (exclusive separator/non-empty list)"+     in prop name+            $ forAll (listsWithoutSep1 sep)+            $ \xss -> do+                  withMaxSuccess maxTestCount $ monadicIO $ testCase xss++    where++    testCase xss = do+        let lxs = lIntercalater [sep] xss+        lys <- splitter lxs [sep]+        sxs <- toList+                $ sIntercalater [sep] Unfold.fromList+                $ Stream.fromList xss+        sys <- splitter sxs [sep]+        listEquals (==) lys xss+        listEquals (==) sys xss++splitterProperties ::+       forall a. (Arbitrary a, Eq a, Show a)+    => a+    -> String+    -> Spec+splitterProperties sep desc = do+    describe (desc <> " splitOn")+        $ do++            intercalateSplitEqId+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq 1++            concatSplitIntercalateEqConcat+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq 1++            -- Exclusive case+            splitIntercalateEqId+                sep splitOn_ intercalate Stream.unfoldEachSepBySeq++    describe (desc <> " splitOnSuffix")+        $ do++            intercalateSplitEqIdNoSepEnd+                sep splitOnSuffix_ intercalate Stream.unfoldEachSepBySeq 1++            concatSplitIntercalateEqConcat+                sep splitOnSuffix_ intercalateSuffix Stream.unfoldEachEndBySeq 1++            -- Exclusive case+            splitIntercalateEqId+                sep splitOnSuffix_ intercalateSuffix Stream.unfoldEachEndBySeq++    where++    splitOn_ xs pat =+        toList $ splitOn (== head pat) Fold.toList (Stream.fromList xs)++    splitOnSuffix_ xs pat =+        toList $ splitOnSuffix (== head pat) Fold.toList (Stream.fromList xs)++seqSplitterProperties ::+       forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)+    => a+    -> String+    -> Spec+seqSplitterProperties sep desc = do+    describe (desc <> " splitOnSeq fold") (splitOnSeqWith splitOnSeq_)+    describe (desc <> " splitOnSeq stream") (splitOnSeqWith splitOnSeqStream_)+    describe (desc <> " splitOnSuffixSeq fold")+        (splitOnSuffixSeqWith splitOnSuffixSeq_)+    describe (desc <> " splitOnSuffixSeq stream")+        (splitOnSuffixSeqWith splitOnSuffixSeqStream_)++    where++    splitOnSeq_ xs pat =+        toList $ splitOnSeqFold (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSeqStream_ xs pat =+        toList $ splitOnSeqStream (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSuffixSeq_ xs pat =+        toList $ splitOnSuffixSeqFold (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSuffixSeqStream_ xs pat =+        toList $ splitOnSuffixSeqStream (Array.fromList pat) Fold.toList (Stream.fromList xs)++    splitOnSeqWith op = do+        forM_ [0, 1, 2, 4]+            $ intercalateSplitEqId sep op intercalate Stream.unfoldEachSepBySeq++        forM_ [0, 1, 2, 4]+            $ concatSplitIntercalateEqConcat+                sep op intercalate Stream.unfoldEachSepBySeq++        -- Exclusive case+        splitIntercalateEqId sep op intercalate Stream.unfoldEachSepBySeq++    splitOnSuffixSeqWith op = do+        forM_ [0, 1, 2, 4]+            $ intercalateSplitEqIdNoSepEnd+                sep op intercalate Stream.unfoldEachSepBySeq++        forM_ [0, 1, 2, 4]+            $ concatSplitIntercalateEqConcat+                  sep op intercalateSuffix Stream.unfoldEachEndBySeq++        -- Exclusive case+        splitIntercalateEqId+            sep op intercalateSuffix Stream.unfoldEachEndBySeq++intercalateSplitOnId ::+       forall a. (Arbitrary a, Eq a, Show a, Num a) =>+       a -> String -> Spec+intercalateSplitOnId x desc =+    prop (desc <> " intercalate [x] . splitOn (== x) == id") $+        forAll listWithZeroes $ \xs -> do+            withMaxSuccess maxTestCount $+                monadicIO $ do+                    ys <- toList $ splitOn (== x) Fold.toList (Stream.fromList xs)+                    listEquals (==) (intercalate [x] ys) xs++    where++    listWithZeroes :: Gen [a]+    listWithZeroes = listOf $ frequency [(3, arbitrary), (1, return 0)]++groupSplitOps :: String -> Spec+groupSplitOps desc = do+    -- splitting++    -- The foldManyPost implementation on an empty stream produces a single+    -- value. The behaviour of foldManyPost implementation and the direct stream+    -- implementation is not different.+    -- splitOnSeq splitOnSeqFold++    splitOnSeq splitOnSeqStream+    splitOnSuffixSeq splitOnSuffixSeqFold++    -- XXX there are no tests for withSep = True option+    splitOnSuffixSeq splitOnSuffixSeqStream+    -- Some ad-hoc tests+    it "splitEndBySeq word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitEndBySeq (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result++        f "ab" "a" ["a"]+        f "ab" "ab" ["ab"]+        f "ab" "aba" ["ab","a"]+        f "ab" "abab" ["ab","ab"]+        f "ab" "abc" ["ab","c"]+        f "ab" "xab" ["xab"]+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a.",".",".","b"]+        f ".." "a...b" ["a..",".b"]+        f "..." "a...b" ["a...","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." ["."]+        f ".." ".." [".."]+        f "..." "..." ["..."]+        f "." ".a" [".","a"]+        f "." "a." ["a."]++    it "splitEndBySeq_ word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitEndBySeq_ (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a","","","b"]+        f ".." "a...b" ["a",".b"]+        f "..." "a...b" ["a","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." [""]+        f ".." ".." [""]+        f "..." "..." [""]+        f "." ".a" ["","a"]+        f "." "a." ["a"]++    it "splitSepBySeq_ word hash cases" $ do+        let f sep input result =+                Stream.toList+                    ( Stream.splitSepBySeq_ (Array.fromList sep) Fold.toList+                    $ Stream.fromList input+                    ) `shouldReturn` result+        f "" "" []+        f "." "" []+        f ".." "" []+        f "..." "" []+        f "" "a...b" ["a",".",".",".","b"]+        f "." "a...b" ["a","","","b"]+        f ".." "a...b" ["a",".b"]+        f "..." "a...b" ["a","b"]+        f "." "abc" ["abc"]+        f ".." "abc" ["abc"]+        f "..." "abc" ["abc"]+        f "." "." ["",""]+        f ".." ".." ["",""]+        f "..." "..." ["",""]+        f "." ".a" ["","a"]+        f "." "a." ["a",""]++    let takeEndBySeq pat input result =+                Stream.toList+                    ( Stream.takeEndBySeq (Array.fromList pat)+                    $ Stream.fromList input+                    ) `shouldReturn` result+    it "takeEndBySeq empty pattern" $ do+        let f = takeEndBySeq ""+        f "" ""+        f "abcd" ""+    it "takeEndBySeq single element pattern" $ do+        let f = takeEndBySeq "a"+        f "" ""+        f "a" "a"+        f "ab" "a"+        f "xa" "xa"+        f "xab" "xa"+    it "takeEndBySeq word hash cases" $ do+        let f = takeEndBySeq "ab"+        f "" ""+        f "a" "a"+        f "ab" "ab"+        f "abc" "ab"+        f "aba" "ab"+        f "abab" "ab"+        f "x" "x"+        f "xa" "xa"+        f "xab" "xab"+        f "xabc" "xab"+    it "takeEndBySeq karp-rabin cases" $ do+        let f = takeEndBySeq "abc"+        f "" ""+        f "a" "a"+        f "ab" "ab"+        f "abc" "abc"+        f "abcd" "abc"+        f "abca" "abc"+        f "abcabc" "abc"+        f "x" "x"+        f "xa" "xa"+        f "xab" "xab"+        f "xabc" "xabc"+        f "xabcd" "xabc"++    -- splitting properties+    splitterProperties (0 :: Int) desc+    splitterProperties (0 :: Word8) desc++    seqSplitterProperties (0 :: Int) desc+    seqSplitterProperties (0 :: Word8) desc++    intercalateSplitOnId (0 :: Int) desc+    intercalateSplitOnId (0 :: Word8) desc++-- |+-- After grouping (and folding) Int stream using @<@ operation,+-- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum.+testGroupsBy :: Property+testGroupsBy =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- run $ Stream.fold (Fold.all (\ls ->+                case ls of+                    [] -> True+                    (x:_) -> x == minimum ls))+                $ groupsBy (<) Fold.toList+                $ Stream.fromList vec+            assert r++testGroups :: Property+testGroups =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- toList $ groupsBy (==) Fold.toList $ Stream.fromList vec+            assert $ r == group vec++testGroupsByRolling :: Property+testGroupsByRolling =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            r <- toList $ groupsByRolling (==) Fold.toList $ Stream.fromList vec+            assert $ r == group vec++-- |+-- If the list is empty, returns Nothing,+-- else wraps the minimum value of the list in Just.+maybeMinimum :: [Int] -> Maybe Int+maybeMinimum [] = Nothing+maybeMinimum ls = Just $ minimum ls++-- |+-- Checks if the @[Int]@ is non-increasing.+decreasing :: [Maybe Int] -> Bool+decreasing [] = True+decreasing xs = and $ zipWith (<=) (tail xs) xs++-- |+-- To check if the minimum elements (after grouping on @<@)+-- are non-increasing (either decrease or remain the same).+-- Had an element been strictly greater, it would have been grouped+-- with that element only.+testGroupsBySep :: Property+testGroupsBySep =+    forAll (choose (0, maxStreamLen)) $ \len ->+        forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do+            a <- toList+                    $ fmap maybeMinimum+                    $ groupsBy (<) Fold.toList+                    $ Stream.fromList vec+            assert $ decreasing a+ testgroupsOf ::  Expectation testgroupsOf =     Stream.toList         (Stream.groupsOf 2 Fold.sum (Stream.enumerateFromTo 1 10))         `shouldReturn` [3::Int, 7, 11, 15, 19] +groupingOps :: Spec+groupingOps = do+    prop "groupsBy" testGroupsBy+    prop "Stream.groups = groups" testGroups+    prop "Stream.groupsByRolling = groups" testGroupsByRolling+    prop "testGroupsBySep" testGroupsBySep+    prop "testgroupsOf" testgroupsOf++{-+-- XXX to be fixed+associativityCheck+    :: String+    -> (Stream IO Int -> Stream IO Int)+    -> Spec+associativityCheck desc t = prop desc assocCheckProp+  where+    assocCheckProp :: [Int] -> [Int] -> [Int] -> Property+    assocCheckProp xs ys zs =+        monadicIO $ do+            let xStream = Stream.fromList xs+                yStream = Stream.fromList ys+                zStream = Stream.fromList zs+            infixAssocstream <-+                run $ Stream.toList $ t $ xStream `Stream.append` yStream `Stream.append` zStream+            assocStream <- run $ Stream.toList $ t $ xStream <> yStream <> zStream+            listEquals (==) infixAssocstream assocStream+-}++max_length :: Int+max_length = 1000++unfold :: Property+unfold = monadicIO $ do+    a <- pick $ choose (0, max_length `div` 2)+    b <- pick $ choose (0, max_length)+    let unf = Unfold.second b Unfold.enumerateFromToIntegral+    ls <- toList $ Stream.unfold unf a+    return $ ls == [a..b]++foldIterateM :: Property+foldIterateM =+    forAll (listOf (chooseInt (0, max_length))) $ \lst -> monadicIO $ do+        let s1 = Prelude.sum lst+            strm =Stream.fromList lst+        ms2 <-+           Stream.fold Fold.latest+                $ fmap getSum+                $ Stream.foldIterateM+                      (return . Fold.take 1 . Fold.sconcat)+                      (return (Sum 0))+                $ fmap Sum strm+        case ms2 of+            Nothing -> assert $ s1 == 0+            Just s2 -> assert $ s1 == s2++sortBy :: Property+sortBy =+    forAll (listOf (chooseInt (0, max_length)))+        $ \lst -> monadicIO $ do+            let s1 = sort lst+            s2 <- toList+                $ StreamK.toStream+                    ( StreamK.sortBy compare+                    $ StreamK.fromStream+                    $ Stream.fromList lst+                    )+            assert $ s1 == s2++------------------------------------------------------------------------------++maxStreamLen :: Int+maxStreamLen = 1000++-- Coverage build takes too long with default number of tests+maxTestCount :: Int+#ifdef DEVBUILD+maxTestCount = 100+#else+maxTestCount = 10+#endif++moduleName :: String+moduleName = "Data.Stream"+ main :: IO ()-main =-    hspec $-    H.parallel $-    modifyMaxSuccess (const 1) $ do-      describe moduleName $ do-        describe "Repeated Fold" $ do-            prop "testgroupsOf" testgroupsOf+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+    describe "Runners" $ do+        -- XXX use an IORef to store and check the side effects+        it "simple serially" $+            Stream.fold Fold.drain+            (Stream.fromPure (0 :: Int)) `shouldReturn` ()+        it "simple serially with IO" $+            Stream.fold Fold.drain+            (Stream.fromEffect $ putStrLn "hello") `shouldReturn` ()++    describe "Construction" $ do+    {-+        -- XXX To be fixed. Copied from old stream Prelude tests.+        -- Add all the construction tests for all stream types.+        serialOps   $ prop "serially repeat" . constructWithRepeat+        serialOps   $ prop "serially repeatM" . constructWithRepeatM+        serialOps   $ prop "serially replicate" . constructWithReplicate+        serialOps   $ prop "serially replicateM" . constructWithReplicateM+        serialOps   $ prop "serially intFromThenTo" .+                            constructWithIntFromThenTo+        serialOps   $ prop "serially DoubleFromThenTo" .+                            constructWithDoubleFromThenTo+        serialOps   $ prop "serially iterate" . constructWithIterate+        -- XXX test for all types of streams+        serialOps   $ prop "serially iterateM" . constructWithIterateM+        serialOps $ prop "serially enumerate" . constructWithEnumerate id+        serialOps $ prop "serially enumerateTo" . constructWithEnumerateTo id+        serialOps $ prop "serially fromIndices" . constructWithFromIndices+        serialOps $ prop "serially fromIndicesM" . constructWithFromIndicesM+        serialOps $ prop "serially fromList" . constructWithFromList id+        serialOps $ prop "serially fromListM" . constructWithFromListM id+        serialOps $ prop "serially unfoldr" . constructWithUnfoldr id+        serialOps $ prop "serially fromPure" . constructWithFromPure id+        serialOps $ prop "serially fromEffect" . constructWithFromEffect id+        serialOps $ prop "serially cons" . constructWithCons Stream.cons+        serialOps $ prop "serially consM" . constructWithConsM Stream.consM id+        -}++        describe "From Generators" $ do+            prop "unfold" unfold++    {-+    describe "Simple Operations" $ serialOps simpleOps++    describe "Functor operations" $ do+        serialOps    $ functorOps (Stream.fromFoldable) "serially" (==)+        serialOps    $ functorOps folded "serially folded" (==)++    describe "Monoid operations" $ do+        serialOps $ monoidOps "serially" mempty (==)++    describe "Serial loops" $ loops fromSerial id reverse++    describe "Bind and Monoidal composition combinations" $ do+        -- XXX Taking a long time when serialOps is used.+        bindAndComposeSimpleOps "Serial" sortEq fromSerial+        bindAndComposeHierarchyOps "Serial" fromSerial+        serialOps $ nestTwoStreams "Serial" id id+        serialOps $ nestTwoStreamsApp "Serial" id id+        composeAndComposeSimpleSerially "Serial <> " (repeat [1..9]) fromSerial+        composeAndComposeSimpleAheadly "Serial <> " (repeat [1 .. 9]) fromSerial+        composeAndComposeSimpleWSerially+            "Serial <> "+            [[1..9], [1..9], [1,3,2,4,6,5,7,9,8], [1,3,2,4,6,5,7,9,8]]+            fromSerial++    describe "Semigroup operations" $ do+        serialOps $ semigroupOps "serially" (==)+        serialOps $ associativityCheck "serial == <>"++    describe "Applicative operations" $ do+        -- The tests using sorted equality are weaker tests+        -- We need to have stronger unit tests for all those+        -- XXX applicative with three arguments+        serialOps $ applicativeOps (Stream.fromFoldable) "serially" (==)+        serialOps $ applicativeOps folded "serially folded" (==)+        serialOps $ applicativeOps1 (Stream.fromFoldable) "serially" (==)+        serialOps $ applicativeOps1 (Stream.fromFoldable) "serially folded" (==)++    -- XXX add tests for indexed/indexedR+    describe "Zip operations" $ do+        -- We test only the serial zip with serial streams and the parallel+        -- stream, because the rate setting in these streams can slow down+        -- zipAsync.+        serialOps   $ prop "zip monadic serially" . zipMonadic (Stream.fromFoldable) (==)+        serialOps   $ prop "zip monadic serially folded" . zipMonadic folded (==)++    -- XXX add merge tests like zip tests+    -- for mergeBy, we can split a list randomly into two lists and+    -- then merge them, it should result in original list+    -- describe "Merge operations" $ do++    describe "Monad operations" $ do+        serialOps   $ prop "serially monad then" . monadThen (Stream.fromFoldable) (==)+        serialOps   $ prop "serially monad then folded" . monadThen folded (==)+        serialOps   $ prop "serially monad bind" . monadBind (Stream.fromFoldable) (==)+        serialOps   $ prop "serially monad bind folded"  . monadBind folded (==)++    describe "Stream transform and combine operations" $ do+        serialOps    $ transformCombineOpsCommon (Stream.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsCommon folded "serially" (==)+        serialOps    $ transformCombineOpsOrdered (Stream.fromFoldable) "serially" (==)+        serialOps    $ transformCombineOpsOrdered folded "serially" (==)+    -}++    -- Just some basic sanity tests for now+    let input = [[1,1] :: [Int],[2,2],[3,3],[4,4],[5,5],[6,6],[7,7],[8,8]]+        mustBe g inp out =+            Stream.toList (StreamK.toStream (StreamK.mergeMapWith g StreamK.fromList (StreamK.fromList inp)))+                `shouldReturn` out+     in do+        it "concatPairsWith serial"+            $ mustBe StreamK.append input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        it "concatPairsWith wSerial"+            $ mustBe StreamK.interleave input [1,5,3,7,2,6,4,8,1,5,3,7,2,6,4,8]+        it "concatPairsWith mergeBy sorted"+            $ mustBe+                (StreamK.mergeBy compare) input [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        it "concatPairsWith mergeBy reversed"+            $ mustBe+                (StreamK.mergeBy compare)+                (reverse input)+                [1,1,2,2,3,3,4,4,5,5,6,6,7,7,8,8]+        prop "sortBy" sortBy++    describe "Stream group and split operations" $ do+        groupSplitOps "serially"++    {-+    describe "Stream elimination operations" $ do+        serialOps    $ eliminationOps (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOps folded "serially folded"+        serialOps    $ eliminationOpsWord8 (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOpsWord8 folded "serially folded"+        serialOps $ \t ->+            prop "drainWhile (> 0)" $ \n ->+                withMaxSuccess maxTestCount $+                monadicIO $ do+                    let xs = [1..n]+                    ioRef <- run $ newIORef ([] :: [Int])+                    run $+                        drainWhile (> 0) . t $+                            Stream.mapM (\a -> modifyIORef' ioRef (a :) >> return a) $+                                Stream.fromList xs+                    strm <- run $ readIORef ioRef+                    listEquals (==) (reverse strm) (takeWhile (> 0) xs)++    -- XXX Add a test where we chain all transformation APIs and make sure that+    -- the state is being passed through all of them.+    describe "Stream serial elimination operations" $ do+        serialOps    $ eliminationOpsOrdered (Stream.fromFoldable) "serially"+        serialOps    $ eliminationOpsOrdered folded "serially folded"+    -}++    describe "Tests for Stream.groupsBy" groupingOps++    -- describe "Tests for exceptions" $ serialOps $ exceptionOps "serially"++    -- describe "Composed MonadThrow serially" $ composeWithMonadThrow fromSerial++    describe "Nesting" $ do+        prop "foldIterateM" foldIterateM
test/Streamly/Test/Data/Stream/Concurrent.hs view
@@ -9,13 +9,14 @@  module Streamly.Test.Data.Stream.Concurrent (main) where -#ifdef DEVBUILD import Control.Concurrent (threadDelay)-#endif import Control.Exception (Exception, try) import Control.Monad (replicateM) import Control.Monad.Catch (throwM)+import Data.Function ( (&) )+import Data.IORef ( newIORef, readIORef, writeIORef) import Data.List (sort)+import Data.Maybe ( isJust, fromJust ) import Data.Word (Word8) import Streamly.Data.Stream (Stream) import Test.Hspec.QuickCheck@@ -23,9 +24,9 @@ import Test.QuickCheck.Monadic (monadicIO, run) import Test.Hspec as H -import qualified Streamly.Data.Fold as Fold ( toList )-import qualified Streamly.Data.Stream as Stream-    ( replicate, fromEffect, fromPure, fromList, fold, take, nil )+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream import qualified Streamly.Internal.Data.Stream.Prelude as Async  import Streamly.Test.Common (listEquals)@@ -218,6 +219,37 @@     list = flip replicateM (return 1 :: IO Int)     stream = Async.parSequence cfg . flip Stream.replicate (return 1 :: IO Int) +drainMapM :: Monad m => (a -> m b) -> Stream m a -> m ()+drainMapM f = Stream.fold (Fold.drainMapM f)++testFromCallback :: IO Int+testFromCallback = do+    ref <- newIORef Nothing+    let stream =+           Stream.parList (Stream.eager True)+                [ fmap Just (Stream.fromCallback (setCallback ref))+                , runCallback ref+                ]+    Stream.fold Fold.sum $ fmap fromJust $ Stream.takeWhile isJust stream++    where++    setCallback ref cb = do+        writeIORef ref (Just cb)++    runCallback ref = Stream.fromEffect $ do+        cb <-+             Stream.repeatM (readIORef ref)+                & Stream.delayPost 0.1+                & Stream.mapMaybe id+                & Stream.fold Fold.one++        Stream.fromList [1..100]+            & Stream.delayPost 0.001+            & drainMapM (fromJust cb)+        threadDelay 100000+        return Nothing+ main :: IO () main = hspec   $ H.parallel@@ -227,10 +259,10 @@   $ describe moduleName $ do         let transform = transformCombineFromList Stream.fromList sortEq -        prop "parEval" $+        prop "parBuffered" $             transform                 (fmap (+2))-                (fmap (+1) . Async.parEval id . fmap (+1))+                (fmap (+1) . Async.parBuffered id . fmap (+1))          asyncSpec $ prop "parSequence" . sequenceReplicate @@ -314,17 +346,17 @@                         (Stream.fromPure 1)                         (Stream.fromPure 2)                 s1 cfg =-                    Async.parApply+                    Async.parCrossApply                         cfg                         (Stream.fromPure (,))                         (par2 cfg)                 s2 cfg =-                    Async.parApply+                    Async.parCrossApply                         cfg                         (s1 cfg)                         (Stream.fromPure 3) :: Stream IO (Int, Int)             in prop1-                "parApply (async arg1)" . cmp (==) ( [(1, 3), (2, 3)]) . s2+                "parCrossApply (async arg1)" . cmp (==) ( [(1, 3), (2, 3)]) . s2          asyncSpec $             let par2 cfg =@@ -333,7 +365,7 @@                         (Stream.fromPure (2 :: Int))                         (Stream.fromPure 3)                 s1 = Stream.fromPure (1 :: Int,)-                s2 cfg = Async.parApply cfg s1 (par2 cfg)+                s2 cfg = Async.parCrossApply cfg s1 (par2 cfg)             in prop1 "apply (async arg2)" . cmp (==) ([(1, 2), (1, 3)]) . s2          -- concat@@ -361,3 +393,4 @@         describe "Exception propagation" $ exceptionPropagation async         -- Ad-hoc tests         it "takes n from stream of streams" $ takeCombined 2+        it "fromCallback" $ testFromCallback `shouldReturn` (50*101)
+ test/Streamly/Test/Data/Stream/Exception.hs view
@@ -0,0 +1,204 @@+module Streamly.Test.Data.Stream.Exception (main)++where++import Control.Concurrent (threadDelay)+import Control.Exception (SomeException, throw, catch, finally, bracket_)+import Control.Monad (when)+import Data.Foldable (sequenceA_)+import Data.Function ((&))+import Data.IORef (IORef, newIORef, atomicModifyIORef', readIORef)+import Streamly.Internal.Control.Exception (AcquireIO, acquire)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream.Prelude (Config)+import System.Mem (performMajorGC)++import qualified Streamly.Internal.Control.Exception as Exception+import qualified Streamly.Internal.Data.Stream.Prelude as Stream+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Data.Fold as Fold++-- IMPORTANT: do not use a blocking operation inside it, otherwise the tests+-- might fail because the operation will become interruptible..+incr :: Num a => IORef a -> IO ()+incr ref = do+    -- tid <- myThreadId+    -- putStrLn $ "Incrementing the counter: " ++ show tid+    atomicModifyIORef' ref (\x -> (x + 1, ()))++-- IMPORTANT: do not use a blocking operation inside it, otherwise the tests+-- might fail because the operation will become interruptible..+decr :: Num a => IORef a -> IO ()+decr ref = do+    atomicModifyIORef' ref (\x -> (x - 1, ()))+    -- tid <- myThreadId+    -- putStrLn $ "Decremented the counter: " ++ show tid++handler :: SomeException -> IO b+handler (e :: SomeException) = do+    -- tid <- myThreadId+    -- putStrLn $ "Child: " ++ show tid ++ " " ++ show e+    -- Rethrowing the exception is important, otherwise the thread will not+    -- exit.+    throw e++run :: Num a => IORef a -> IO c -> IO c+run ref x = bracket_ (incr ref) (decr ref) (x `catch` handler)++timeout :: Int+timeout = 1000000++takeCount :: Int+takeCount = 1++stream :: IORef Int -> (Config -> Config) -> Stream.Stream IO ()+stream ref modifier =+      Stream.enumerateFrom (1 :: Int)+        & Stream.parMapM modifier+            ( \x ->+              -- somehow if all of them have same timeout then the chances of+              -- failure are more.+              run ref $ threadDelay (if x == 1 then 1000000 else timeout)+            )+        & Stream.take takeCount++streamRelease ::+    AcquireIO -> IORef Int -> IORef Int -> (Config -> Config) -> Stream IO ()+streamRelease aref ref1 ref2 modifier =+      Stream.enumerateFrom (1 :: Int)+        & Stream.parMapM modifier+            ( \x -> do+              if x <= 10+              then do+                -- IMPORTANT: do not put interruptile operations in the+                -- release function, otherwise the tests might fail,+                -- because the operation will become interruptible.+                  ((), release) <-+                        acquire aref (incr ref1) (\() -> decr ref1)+                  -- 1000 makes a particular bug surface, not less, not more+                  threadDelay 1000+                  -- putStrLn $ "release: " ++ show x+                  release+              else do+                  run ref2 $ threadDelay timeout+            )+        & Stream.take 10++finalAction :: Bool -> IORef Int -> Int -> IO ()+finalAction gc ref t = do+    -- When cleanup happens via GC, ghc creates a thread for the finalizer to+    -- run, actual cleanup time depends on when that thread is scheduled. The+    -- thread may outlive one or more GCs. So we have to give it some time to+    -- finish. But it cannot be deterministic.+    -- threadDelay 1000000+    when gc $ do+        performMajorGC+        threadDelay t+        performMajorGC+        threadDelay t+    r <- readIORef ref+    putStrLn $ "Pending computations: " ++ show r+    -- Delay for letting any gc based cleanup threads drain and print output+    -- for debugging+    -- when gc $ threadDelay 1000000+    when (r /= 0) $ error "Failed"++testStream :: Int -> (Config -> Config) -> IO ()+testStream t cfg = do+    ref <- newIORef (0 :: Int)+    (Stream.withAcquireIO (\aref -> stream ref (cfg . Stream.useAcquire aref))+        -- XXX enable this when stream finalization is implemented+        -- & Stream.take 1+        & Stream.fold Fold.drain) `finally` finalAction False ref t++testStreamRelease :: Int -> (Config -> Config) -> IO ()+testStreamRelease count cfg = do+    ref1 <- newIORef (0 :: Int)+    ref2 <- newIORef (0 :: Int)+    (Stream.withAcquireIO (\aref -> do+            let cfg1 = cfg . Stream.useAcquire aref+            streamRelease aref ref1 ref2 cfg1)+        -- XXX enable this when stream finalization is implemented+        -- & Stream.take 1+        & Stream.fold Fold.drain+       )+       `finally` do+            putStrLn "Checking MANUALLY released resources..."+            finalAction False ref1 count+            putStrLn "Checking AUTO released resources..."+            finalAction False ref2 count++testEffect :: Int -> (Config -> Config) -> IO ()+testEffect t cfg = do+    ref <- newIORef (0 :: Int)+    Exception.withAcquireIO (\aref ->+        stream ref (cfg . Stream.useAcquire aref)+        & Stream.take 1+        & Stream.fold Fold.drain+      ) `finally` finalAction False ref t++testEffectRelease :: Int -> (Config -> Config) -> IO ()+testEffectRelease count cfg = do+    ref1 <- newIORef (0 :: Int)+    ref2 <- newIORef (0 :: Int)+    Exception.withAcquireIO (\aref -> do+            let cfg1 = cfg . Stream.useAcquire aref+            streamRelease aref ref1 ref2 cfg1+                & Stream.take 1+                & Stream.fold Fold.drain+      ) `finally` do+            putStrLn "Checking MANUALLY released resources..."+            finalAction False ref1 count+            putStrLn "Checking AUTO released resources..."+            finalAction False ref2 count++finallyGC :: Int -> (Stream.Config -> Stream.Config) -> IO ()+finallyGC t cfg = do+    ref <- newIORef (0 :: Int)+    Stream.finallyIO (finalAction True ref t) (stream ref cfg)+        & Stream.fold Fold.drain++-- XXX Include rate as well+limits :: [(String, Stream.Config -> Stream.Config)]+limits =+    [ ("default", id)+    , ("maxBuffer 10", Stream.maxBuffer 10)+    , ("maxThreads 10", Stream.maxThreads 10)+    ]++sched :: [(String, Stream.Config -> Stream.Config)]+sched =+    [ ("default", id)+    , ("eager", Stream.eager True)+    , ("ordered", Stream.ordered True)+    , ("interleaved", Stream.interleaved True)+    ]++funcs :: [(String, Int -> (Stream.Config -> Stream.Config) -> IO ())]+funcs =+    [ ("Stream.withAcquireIO", testStream)+    , ("Exception.withAcquireIO", testEffect)+    , ("Stream.withAcquireIO release", testStreamRelease)+    , ("Exception.withAcquireIO release", testEffectRelease)+    , ("finallyGC", finallyGC)+    ]++main :: IO ()+main = do+    let cfg = id -- Stream.inspect True++    -- TODO: Interrupt test+    -- Run the main test in a separate thread. Keep the thread-id in a global+    -- variable which will be used to interrupt the thread. Once one thread is+    -- over then the next test will keep it's threadId in the global var.+    -- Run another thread which sleeps for random intervals and sends+    -- UserInterrupt exception to the current test thread-id stored in the+    -- glbal variable in a loop.+    -- TODO: test for non-concurrent use cases as well+    sequenceA_+        [ putStrLn ("Running: " ++ fst f ++ " " ++ fst x1 ++ " " ++ fst x2)+            >> snd f+                (if fst x1 == "default" then 500000 else 100000)+                (snd x1 . snd x2 . cfg)+        | f <- funcs, x1 <- limits, x2 <- sched+        ]
+ test/Streamly/Test/Data/Stream/Rate.hs view
@@ -0,0 +1,287 @@+-- |+-- Module      : Streamly.Test.Data.Stream.Rate+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream.Rate (main) where++import Data.Int (Int64)+import Streamly.Data.Stream.Prelude (Config)+import Streamly.Internal.Data.Time.Clock (getTime, Clock(..))+import Streamly.Internal.Data.Time.Units+    (NanoSecond64, diffAbsTime64, fromRelTime64)+import System.Mem (performMajorGC)++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream++import Control.Concurrent+import Control.Monad+import System.Random+import Test.Hspec++durationShouldBe :: (Double, Double) -> IO () -> Expectation+durationShouldBe d@(tMin, tMax) action = do+        t0 <- getTime Monotonic+        action+        t1 <- getTime Monotonic+        let diff = fromRelTime64 (diffAbsTime64 t1 t0) :: NanoSecond64+        let t = fromIntegral diff / 1e9+        putStrLn $ "Expected: " <> show d <> " Took: " <> show t+        (t <= tMax && t >= tMin) `shouldBe` True++toMicroSecs :: Num a => a -> a+toMicroSecs x = x * 10^(6 :: Int)++measureRate' ::+       String+    -> (Config -> Config)+    -> Int -- buffers+    -> Int -- threads+    -> Either Double Int  -- either rate or count of actions+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRate'+    desc modifier buffers threads rval consumerDelay producerDelay expectedRange = do+    it (desc <> rateDesc+             <> " buffers: " <> show buffers+             <> " threads: " <> show threads+             <> ", consumer latency: " <> show consumerDelay+             <> ", producer latency: " <> show producerDelay)+        runTest++    where++    -- Keep a minimum of 2 for the very low rate cases, otherwise the+    -- timing would be 0 because we will finish as soon as the first result+    -- arrives.+    yieldCount :: Int+    yieldCount = case rval of+        Left r -> max 2 (round (10 * r))+        Right n -> max 2 n++    rateDesc = (case rval of+        Left r ->  ", rate: " <> show r <> ", count: " <> show yieldCount+        Right n -> ", count: " <> show n) <> ","++    cfg (_n :: Maybe Int64) =+          modifier+        . Stream.maxBuffer buffers+        -- . Stream.inspect True+        . Stream.maxThreads threads+        . case rval of+            Left r -> Stream.avgRate r+            Right _ -> Stream.rate Nothing+        -- XXX it comes out less than expected for ordered streams at high+        -- rates, need to fix.+        -- . Stream.maxYields (Just (fromIntegral yieldCount))++    threadAction f =+        case rval of+            Left _ ->+                  Stream.take yieldCount+                $ Stream.parMapM (cfg (Just (fromIntegral yieldCount))) f+                $ Stream.enumerateFrom (1 :: Int)+            Right _ ->+                Stream.parReplicateM+                    (cfg (Just (fromIntegral yieldCount))) yieldCount (f 1)++    runTest = do+        durationShouldBe expectedRange $ do+            res <- Stream.fold Fold.length+                $ (if consumerDelay > 0+                  then Stream.mapM $ \x ->+                            threadDelay (toMicroSecs consumerDelay) >> return x+                  else id)+                $ threadAction $ \_idx -> do+                    let (t1, t2) = producerDelay+                    r <- if t1 == t2+                         then return $ round $ toMicroSecs t1+                         else randomRIO ( round $ toMicroSecs t1+                                        , round $ toMicroSecs t2)+                    when (r > 0) $ -- do+                        -- t1 <- getTime Monotonic+                        threadDelay r+                        -- t2 <- getTime Monotonic+                        -- let delta = fromIntegral (toNanoSecs (t2 - t1)) / 1000000000+                        -- putStrLn $ "delay took: " <> show delta+                        -- when (delta > 2) $ do+                        --     putStrLn $ "delay took high: " <> show delta+                    -- putStrLn $ "Done: " ++ show idx+                    return (1 :: Int)+            when (res /= yieldCount) $+                error $ "expected yield count: " ++ show yieldCount+                    ++ " actual: " ++ show res++        -- To ensure that when we use "inspect" option on the channel, GC+        -- occurs and cleans up the channel to print the debug info.+        performMajorGC++measureRateVariable ::+       String+    -> (Config -> Config)+    -> Double+    -> Int+    -> (Double, Double)+    -> (Double, Double)+    -> Spec+measureRateVariable desc modifier rval =+    measureRate' desc modifier (-1) (-1) (Left rval)++measureRate ::+       String+    -> (Config -> Config)+    -> Double+    -> Int+    -> Int+    -> (Double, Double)+    -> Spec+measureRate desc modifier rval consumerDelay producerDelay dur =+    let d = fromIntegral producerDelay+    in measureRateVariable desc modifier rval consumerDelay (d, d) dur++measureThreads ::+       String+    -> (Config -> Config)+    -> Int -- threads+    -> Int -- count of actions+    -> Spec+measureThreads desc modifier threads count = do+    let expectedTime =+            if threads < 0+            then 1.0+            else fromIntegral count / fromIntegral threads+        duration = (expectedTime * 0.9, expectedTime * 1.1)+    measureRate' desc modifier (-1) threads (Right count) 0 (1,1) duration++measureBuffers ::+       String+    -> (Config -> Config)+    -> Int -- buffers+    -> Int -- count of actions+    -> Spec+measureBuffers desc modifier buffers count = do+    let expectedTime =+            if buffers < 0+            then 1.0+            else fromIntegral count / fromIntegral buffers+        duration = (expectedTime * 0.9, expectedTime * 1.1)+    measureRate' desc modifier buffers (-1) (Right count) 0 (1,1) duration++moduleName :: String+moduleName = "Data.Stream.Rate"++main :: IO ()+main = hspec $ do+  describe moduleName $ do++    describe "maxBuffers" $ do+        measureBuffers "async" id (-1) 5+        -- XXX this test fails due to a known issue+        -- measureBuffers "maxBuffers" id 1 5+        measureBuffers "async" id 5 5++    describe "maxThreads" $ do+        measureThreads "async" id (-1) 5+        measureThreads "async" id 1 5+        measureThreads "async" id 5 5++        measureThreads "ordered" (Stream.ordered True) (-1) 5+        measureThreads "ordered" (Stream.ordered True) 1 5+        measureThreads "ordered" (Stream.ordered True) 5 5++        measureThreads "interleaved" (Stream.interleaved True) (-1) 5+        measureThreads "interleaved" (Stream.interleaved True) 1 5+        measureThreads "interleaved" (Stream.interleaved True) 5 5++    describe "max rate possible (count / time)" $ do+        measureRate "async" (Stream.rate Nothing) 1000000 0 0 (0, 1e9)++    let range = (8,12)++    -- Note that because after the last yield we don't wait, the last period+    -- will be effectively shorter. This becomes significant when the rates are+    -- lower (1 or lower). For rate 1 we lose 1 second in the end and for rate+    -- 10 0.1 second.+    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "async no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "async" id r 0 0 range)++    -- XXX try staggering the dispatches to achieve higher rates+    -- Producer delay causes a lot of threads to be created, consuming large+    -- amounts of memory at higher rates.+    let rates = [0.1, 1, 10, 100+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                1000, 10000, 25000+#endif+                ]+     in describe "async no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "async" id r 0 1 range)++    -- At lower rates (1/10) this is likely to vary quite a bit depending on+    -- the spread of random producer latencies generated.+    let rates = [1, 10, 100+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 1000, 10000, 25000+#endif+                ]+     in describe "async, no consumer delay and variable producer delay" $+            forM_ rates $ \r ->+                measureRateVariable "async" id r 0 (0.1, 3) range++    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "interleaved, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "interleaved" (Stream.interleaved True) r 0 0 range)++    let rates = [0.1, 1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 25000+#endif+                ]+     in describe "interleaved, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "interleaved" (Stream.interleaved True) r 0 1 range)++    let rates = [0.1, 1, 10, 100, 1000, 10000+#ifndef __GHCJS__+                , 100000, 1000000+#endif+                ]+     in describe "ordered, no consumer delay no producer delay" $+            forM_ rates (\r -> measureRate "ordered" (Stream.ordered True) r 0 0 range)++    -- XXX after the change to stop workers when the heap is clearing+    -- thi does not work well at a 25000 ops per second, need to fix.+    let rates = [0.1, 1, 10, 100, 1000+#if !defined(__GHCJS__) && defined USE_LARGE_MEMORY+                , 10000, 12500+#endif+                ]+     in describe "ordered, no consumer delay and 1 sec producer delay" $+            forM_ rates (\r -> measureRate "ordered" (Stream.ordered True) r 0 1 range)++    describe "async, some consumer delay and 1 sec producer delay" $ do+        -- ideally it should take 10 x 1 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 1 1 (11, 16))+        -- ideally it should take 10 x 2 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 2 1 (21, 23))+        -- ideally it should take 10 x 3 + 1 seconds+        forM_ [1] (\r -> measureRate "async" id r 3 1 (31, 33))++    describe "ordered, some consumer delay and 1 sec producer delay" $ do+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 1 1 (11, 16))+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 2 1 (21, 23))+        forM_ [1] (\r -> measureRate "ordered" (Stream.ordered True) r 3 1 (31, 33))
+ test/Streamly/Test/Data/Stream/Time.hs view
@@ -0,0 +1,95 @@+-- XXX We are using head/tail at one place+#if __GLASGOW_HASKELL__ >= 908+{-# OPTIONS_GHC -Wno-x-partial #-}+#endif++-- |+-- Module      : Streamly.Test.Data.Stream+-- Copyright   : (c) 2019 Composewell technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Test.Data.Stream.Time (main) where++#ifdef DEVBUILD+import Control.Concurrent ( threadDelay )+import Control.Monad ( when)+import Data.Int (Int64)+import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)+import Streamly.Internal.Data.Time.Units+       (AbsTime, NanoSecond64(..), toRelTime64, diffAbsTime64)++import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream.Prelude as Stream++#endif++import Test.Hspec as H++#ifdef DEVBUILD+tenPow8 :: Int64+tenPow8 = 10^(8 :: Int)++tenPow7 :: Int64+tenPow7 = 10^(7 :: Int)++takeDropTime :: NanoSecond64+takeDropTime = NanoSecond64 $ 5 * tenPow8++checkTakeDropTime :: (Maybe AbsTime, Maybe AbsTime) -> IO Bool+checkTakeDropTime (mt0, mt1) = do+    let graceTime = NanoSecond64 $ 8 * tenPow7+    case mt0 of+        Nothing -> return True+        Just t0 ->+            case mt1 of+                Nothing -> return True+                Just t1 -> do+                    let tMax = toRelTime64 (takeDropTime + graceTime)+                    let tMin = toRelTime64 (takeDropTime - graceTime)+                    let t = diffAbsTime64 t1 t0+                    let r = t >= tMin && t <= tMax+                    when (not r) $ putStrLn $+                        "t = " ++ show t +++                        " tMin = " ++ show tMin +++                        " tMax = " ++ show tMax+                    return r++testTakeInterval :: IO Bool+testTakeInterval = do+    r <-+         Stream.fold (Fold.tee Fold.one Fold.latest)+        $ Stream.takeInterval (fromIntegral takeDropTime * 10**(-9))+        $ Stream.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime r++testDropInterval :: IO Bool+testDropInterval = do+    t0 <- getTime Monotonic+    mt1 <-+         Stream.fold Fold.one+        $ Stream.dropInterval (fromIntegral takeDropTime * 10**(-9))+        $ Stream.repeatM (threadDelay 1000 >> getTime Monotonic)+    checkTakeDropTime (Just t0, mt1)+#endif++moduleName :: String+moduleName = "Data.Stream.Time"++main :: IO ()+main = hspec+  $ H.parallel+#ifdef COVERAGE_BUILD+  $ modifyMaxSuccess (const 10)+#endif+  $ describe moduleName $ do+#ifdef DEVBUILD+        describe "Filtering" $ do+            it "takeInterval" (testTakeInterval `shouldReturn` True)+            it "dropInterval" (testDropInterval `shouldReturn` True)+#endif+        it "dummy" (return () `shouldReturn` ())+
test/Streamly/Test/Data/Unbox.hs view
@@ -26,11 +26,13 @@ import qualified Streamly.Internal.Data.Array as Array #endif +import GHC.Fingerprint (Fingerprint(..))+ import Data.Complex (Complex ((:+))) import Data.Functor.Const (Const (..)) import Data.Functor.Identity (Identity (..)) import Data.Proxy (Proxy(..))-import GHC.Generics (Generic, Rep(..))+import GHC.Generics (Generic, Rep) import GHC.Real (Ratio(..))  import Streamly.Internal.Data.MutByteArray@@ -168,8 +170,11 @@ -- Standalone derivations -------------------------------------------------------------------------------- --- Ratio does not have a Generic instance by default+-- The following types don't have a Generic instance by default deriving instance Generic (Ratio Int)+#if !MIN_VERSION_base(4,15,0)+deriving instance Generic (Fingerprint)+#endif  #if defined(USE_SERIALIZE) $(deriveSerialize@@ -331,10 +336,9 @@     it "GenericConsistency (Identity Int)"         $ testGenericConsistency (Identity 56760 :: Identity Int) -    -- Fingerprint does not work for GHC 8.6.5-    -- it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)-    -- it "GenericConsistency Fingerprint"-    --     $ testGenericConsistency (Fingerprint 123456 876588)+    it "Fingerprint" $ testSerialization (Fingerprint 123456 876588)+    it "GenericConsistency Fingerprint"+        $ testGenericConsistency (Fingerprint 123456 876588)  -------------------------------------------------------------------------------- -- Main function
test/Streamly/Test/Data/Unfold.hs view
@@ -72,8 +72,8 @@  both :: Bool both =-    let unf = UF.both 1 (UF.function id)-     in testUnfold unf undefined ([1] :: [Int])+    let unf = UF.supply 1 (UF.function id)+     in testUnfold unf () ([1] :: [Int])  first :: Bool first =@@ -468,8 +468,8 @@     property         $ \f list ->               let fA = applyFun2 f :: [Int] -> Int -> Int-                  fM x y = modify (+ 1) >> return (fA x y)-                  unf = UF.mapM2 fM UF.fromList+                  fM (x, y) = modify (+ 1) >> return (fA x y)+                  unf = UF.mapM fM (UF.carry UF.fromList)                   mList = Prelude.map (fA list) list                in testUnfoldMD unf list 0 (length list) mList @@ -549,7 +549,7 @@ concat =     let unfIn = UF.replicateM         unfOut = UF.map ((10,) . return) UF.enumerateFromToIntegral-        unf = UF.many unfIn unfOut+        unf = UF.unfoldEach unfIn unfOut         lst = Prelude.concat $ Prelude.map (Prelude.replicate 10) [1 .. 10]      in testUnfoldD unf (1, 10) lst
+ test/Streamly/Test/FileSystem/DirIO.hs view
@@ -0,0 +1,200 @@+-- |+-- Module      : Streamly.Test.FileSystem.DirIO+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++{-# LANGUAGE CPP #-}++{-# OPTIONS_GHC -Wno-unrecognised-warning-flags #-}+{-# OPTIONS_GHC -Wno-x-partial #-}++module Main (main) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Exception (try, IOException)+import Data.Word (Word8)+import GHC.IO.Encoding (setLocaleEncoding, utf8)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Data.Array (Array)+#endif+import System.Directory (createDirectoryLink)++import qualified Streamly.Unicode.Stream as Unicode+import qualified Streamly.Internal.Unicode.Stream as Unicode (lines)+import qualified Streamly.Data.Stream.Prelude as Stream+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Data.StreamK as StreamK+import qualified Streamly.Internal.FileSystem.DirIO as Dir++import Prelude hiding (last, length)+import BenchTestLib.DirIO++import Test.Hspec as H++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++moduleName :: String+moduleName = "FileSystem.DirIO"++testCorrectness+    :: [FilePath] -> Stream.Stream IO Word8 -> Expectation+testCorrectness expectation lister = do+    reality <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream+            $ Unicode.lines Fold.toList+            $ Unicode.decodeUtf8 lister+    reality `shouldBe` expectation++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+testCorrectnessByteChunked+    :: [FilePath] -> Stream.Stream IO (Array Word8) -> Expectation+testCorrectnessByteChunked expectation lister = do+    reality <-+         Stream.fold Fold.toList+             $ StreamK.toStream+             $ StreamK.sortBy compare+             $ StreamK.fromStream+             $ Unicode.lines Fold.toList+             $ Unicode.decodeUtf8Chunks lister+    reality `shouldBe` expectation+#endif++ignoringError :: IO a -> IO ()+ignoringError act = do+    (_ :: Either IOException a) <- try act+    pure ()++testSymLinkFollow :: Spec+testSymLinkFollow = do+    let fp = "benchmark-tmp/dir-structure-small-sym"+    -- We create and use a different directory tree here for these tests because+    -- of convinence.+    pathsUnsorted <- runIO $ createDirStucture fp 2 3+    paths <-+        runIO+            $ Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsUnsorted+    runIO $ ignoringError $ do+        createDirectoryLink "./dir_1" (fp ++ "/sym-link-1")+        createDirectoryLink "./dir_1/dir_2" (fp ++ "/sym-link-2")+        createDirectoryLink "./broken_link" (fp ++ "/sym-link-3")+    let answerFollowSym =+            (fp ++ "/sym-link-1")+                : (fp ++ "/sym-link-1/dir_1")+                : (fp ++ "/sym-link-1/dir_2")+                : (fp ++ "/sym-link-1/dir_3")+                : (fp ++ "/sym-link-2")+                : paths+        answerNoFollowSym =+            (fp ++ "/sym-link-1")+                : (fp ++ "/sym-link-2")+                : (fp ++ "/sym-link-3")+                : paths+    sortedAnswerFollowSym <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList answerFollowSym+    sortedAnswerNoFollowSym <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList answerNoFollowSym+    describe "Symlink" $ do+        it "followSymlinks True" $+            testCorrectness+                sortedAnswerFollowSym+                (listDirUnfoldDfs+                     (Dir.followSymlinks True . Dir.ignoreMissing True)+                     fp)+        it "followSymlinks False" $+            testCorrectness+                sortedAnswerNoFollowSym+                (listDirUnfoldDfs+                     (Dir.followSymlinks False . Dir.ignoreMissing True)+                     fp)++-- | List the current directory recursively+main :: IO ()+main = do+    setLocaleEncoding utf8++    let smallTree = "benchmark-tmp/dir-structure-small"+        bigTree = "benchmark-tmp/dir-structure-big"+    pathsSmallUnsorted <- createDirStucture smallTree 2 3+    pathsBigUnsorted <- createDirStucture bigTree 5 5++    pathsSmall <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsSmallUnsorted+    pathsBig <-+        Stream.fold Fold.toList+            $ StreamK.toStream+            $ StreamK.sortBy compare+            $ StreamK.fromStream $ Stream.fromList pathsBigUnsorted++    hspec $+      describe moduleName $ do+        describe "Sanity" $ do+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+            it "listDirByteChunked" $+                testCorrectnessByteChunked+                    (tail pathsBig) (listDirByteChunked bigTree)+#endif+            -- NOTE: The BFS traversal fails with:+            -- openDirStream: resource exhausted (Too many open files)+            -- if a bigger directory tree is used+            it "listDirUnfoldDfs" $+               testCorrectness pathsBig (listDirUnfoldDfs id bigTree)+            it "listDirUnfoldBfs" $+               testCorrectness pathsSmall (listDirUnfoldBfs id smallTree)+            it "listDirUnfoldBfsRev" $+               testCorrectness pathsSmall (listDirUnfoldBfsRev id smallTree)+            it "listDirConcatDfs" $+               testCorrectness pathsBig (listDirConcatDfs id bigTree)+            it "listDirConcatBfs" $+               testCorrectness pathsSmall (listDirConcatBfs id smallTree)+            it "listDirConcatBfsRev" $+               testCorrectness pathsSmall (listDirConcatBfsRev id smallTree)+            it "listDirAppend" $+               testCorrectness pathsBig (listDirAppend id bigTree)+            it "listDirInterleave" $+               testCorrectness pathsBig (listDirInterleave id bigTree)+            it "listDirPar" $+               testCorrectness pathsBig (listDirPar id bigTree)+            it "listDirParInterleaved" $+               testCorrectness pathsBig (listDirParInterleaved id bigTree)+            it "listDirParOrdered" $+               testCorrectness pathsBig (listDirParOrdered id bigTree)+            it "listDirChunkDfs" $+               testCorrectness pathsBig (listDirChunkDfs id bigTree)+            it "listDirChunkBfs" $+               testCorrectness pathsSmall (listDirChunkBfs id smallTree)+            it "listDirChunkBfsRev" $+               testCorrectness pathsSmall (listDirChunkBfsRev id smallTree)+            it "listDirChunkAppend" $+               testCorrectness pathsBig (listDirChunkAppend id bigTree)+            it "listDirChunkInterleave" $+               testCorrectness pathsBig (listDirChunkInterleave id bigTree)+            it "listDirChunkPar" $+               testCorrectness pathsBig (listDirChunkPar id bigTree)+            it "listDirChunkParInterleaved" $+               testCorrectness pathsBig (listDirChunkParInterleaved id bigTree)+            it "listDirChunkParOrdered" $+               testCorrectness pathsBig (listDirChunkParOrdered id bigTree)+        testSymLinkFollow
test/Streamly/Test/FileSystem/Event.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event -- Copyright   : (c) 2021 Composewell Technologies
test/Streamly/Test/FileSystem/Event/Common.hs view
@@ -53,6 +53,8 @@     ( createDirectory     , createDirectoryIfMissing     , createDirectoryLink+    , doesDirectoryExist+    , doesFileExist     , removeFile     , removePathForcibly     , renameDirectory@@ -173,11 +175,13 @@                             openFile root WriteMode >>= hClose                             return root                         SymLinkResolvedPath -> do+                            -- root -> target                             let tgt = fp </> "watch-root-real"                             createDirectory tgt                             createDirectoryLink tgt root                             return tgt                         SymLinkOrigPath -> do+                            -- root -> target                             let tgt = fp </> "watch-root-real"                             createDirectory tgt                             createDirectoryLink tgt root@@ -189,7 +193,11 @@                 startWatchAndCheck root target sync      startWatchAndCheck root target sync = do+            putStrLn ("Before pre op: root [" <> root+                    <> "] target [" <> target <> "]")             pre root+            putStrLn ("After pre op: root [" <> root+                    <> "] target [" <> target <> "]")             -- XXX On macOS the events from pre ops also seem to be bundled             -- with the events occurred after the watch is started.             let check = checker root target sync expected@@ -202,9 +210,11 @@         -- not ensure that the event watcher has actually started. So we need a         -- delay as well. Do we?         takeMVar sync >> threadDelay 200000+        putStrLn ("Before fs ops: root [" <> fp)         ops fp+        putStrLn ("After fs ops: root [" <> fp)         threadDelay 10000000-        error "Time out occurred before event watcher could terminate"+        error $ fp <> ": Time out occurred before event watcher could terminate"  ------------------------------------------------------------------------------- -- Test descriptions@@ -233,7 +243,7 @@  createParent :: FilePath -> FilePath -> IO () createParent file parent = do-    createDirectoryIfMissing True (parent </> takeDirectory file)+    createDirectoryIfMissing True (takeDirectory (parent </> file))  createDirWithParent :: FilePath -> FilePath -> IO () createDirWithParent dir parent =@@ -301,9 +311,25 @@  createFileWithParent :: FilePath -> FilePath -> IO () createFileWithParent file parent = do-    when (not (null file)) $-        createDirectoryIfMissing True (parent </> takeDirectory file)-    openFile (parent </> file) WriteMode >>= hClose+    let filepath = parent </> file+    let dir = takeDirectory filepath+    putStrLn $ "createFileWithParent: file ["+        ++ file ++ "] dir [" ++ dir ++ "]"+    putStrLn $ "Ensuring dir: " ++ dir+    createDirectoryIfMissing True dir+    r <- doesDirectoryExist dir+    if r+    then do+        putStrLn $ "Ensured dir: " ++ dir+        when (not (null file)) $ do+            exists <- doesFileExist filepath+            if not exists+            then do+                putStrLn $ "Creating file: " ++ (parent </> file)+                openFile (parent </> file) WriteMode >>= hClose+                putStrLn $ "Created file: " ++ (parent </> file)+            else error $ "File exists: " ++ filepath+    else error $ "Could not create dir: " ++ dir  createFile :: FilePath -> FilePath -> IO () createFile file parent =
test/Streamly/Test/FileSystem/Event/Darwin.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event.Darwin -- Copyright   : (c) 2020 Composewell Technologies
test/Streamly/Test/FileSystem/Event/Linux.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Test.FileSystem.Event.Linux -- Copyright   : (c) 2020 Composewell Technologies@@ -9,10 +11,16 @@ module Streamly.Test.FileSystem.Event.Linux (main) where  import Streamly.Internal.FileSystem.Event.Linux (Event)+-- #if __GLASGOW_HASKELL__ == 902+#if 0+import qualified Data.List as List+#endif import qualified Streamly.Internal.FileSystem.Event.Linux as Event  import Streamly.Test.FileSystem.Event.Common +#define DEVBUILD+ moduleName :: String moduleName = "FileSystem.Event.Linux" @@ -92,18 +100,39 @@             : regSymTests      let symTests =-             -- when root is a symlinked dir, it does not recv touch, isDeleted-             -- or rootDeleted, rootUnwatched events.+#if 0+             -- No events occur when a symlink root is moved. when root is a+             -- symlinked dir, it does not recv touch, isDeleted or+             -- rootDeleted, rootUnwatched events. We are not seeing+             -- isAttrModified event as well, so disabling this altogether.               dirDelete "" (\dir -> [(dir, dirEvent Event.isAttrsModified)])-            -- No events occur when a symlink root is moved-            : regSymTests+            :+#endif+            regSymTests      let w = Event.watchWith (Event.setAllEvents True)         run = runTests moduleName "non-recursive" w -    run DirType regTests-    run SymLinkOrigPath symTests+#if 0+    let failingTests =+            [ "File deleted (file1)"+            , "File modified (file1)"+            , "File moved (file1 file2)"+            ]+#endif +    run DirType+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingTests)+#endif+        regTests++    run SymLinkOrigPath+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingTests)+#endif+        symTests+     let fileRootTests =             [ fileDelete "" (\path ->                 [ (path, Event.isAttrsModified)@@ -157,7 +186,25 @@     --      uncaught exception: IOException of type ResourceBusy     --      /tmp/fsevent_dir-a5bd0df64c44ab27/watch-root/file: openFile: resource busy (file is locked) -    runRec DirType recRegTests-    runRec SymLinkOrigPath recSymTests+#if 0+    let failingRecTests = failingTests +++            [ "File created (subdir/file)"+            , "File deleted (subdir/file1)"+            , "File modified (subdir/file1)"+            , "File moved (subdir/file1 subdir/file2)"+            ]+#endif++    runRec DirType+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingRecTests)+#endif+        recRegTests++    runRec SymLinkOrigPath+#if 0+        $ filter (\(desc, _, _, _) -> desc `List.notElem` failingRecTests)+#endif+        recSymTests #endif     runRec FileType fileRootTests
test/Streamly/Test/FileSystem/Event/Windows.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}
+
 -- |
 -- Module      : Streamly.Test.FileSystem.Event.Windows
 -- Copyright   : (c) 2020 Composewell Technologies
test/Streamly/Test/FileSystem/Handle.hs view
@@ -20,21 +20,32 @@     , hClose     , hFlush     , hSeek-    , openFile+    , hPutStr     ) import System.IO.Temp (withSystemTempDirectory)+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Streamly.Internal.FileSystem.Posix.File (openFile, withFile)+#else+import Streamly.Internal.FileSystem.Windows.File (openFile, withFile)+#endif import Test.QuickCheck (Property, forAll, Gen, vectorOf, choose) import Test.QuickCheck.Monadic (monadicIO, assert, run)+import Streamly.Internal.FileSystem.Path (Path)  import qualified Streamly.Data.Fold as Fold import qualified Streamly.Internal.FileSystem.Handle as Handle import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Unicode.Stream as Unicode+import qualified Streamly.Internal.FileSystem.Path as Path +import Prelude hiding (writeFile) import Test.Hspec as H import Test.Hspec.QuickCheck +writeFile :: Path -> String -> IO ()+writeFile fpath val = withFile fpath WriteMode (`hPutStr` val)+ maxArrLen :: Int maxArrLen = defaultChunkSize * 8 @@ -63,7 +74,7 @@ executor :: (Handle -> Stream IO Char) -> IO (Stream IO Char) executor f =     withSystemTempDirectory "fs_handle" $ \fp -> do-        let fpath = fp </> "tmp_read.txt"+        fpath <- Path.fromString $ fp </> "tmp_read.txt"         writeFile fpath testDataLarge         h <- openFile fpath ReadMode         return $ f h@@ -115,7 +126,7 @@                  go list =                     withSystemTempDirectory "fs_handle" $ \fp -> do-                        let fpathWrite = fp </> "tmp_write.txt"+                        fpathWrite <- Path.fromString $ fp </> "tmp_write.txt"                         writeFile fpathWrite ""                         h <- openFile fpathWrite ReadWriteMode                         hSeek h AbsoluteSeek 0@@ -136,8 +147,8 @@          go =             withSystemTempDirectory "fs_handle" $ \fp -> do-                let fpathRead = fp </> "tmp_read.txt"-                    fpathWrite = fp </> "tmp_write.txt"+                fpathRead <- Path.fromString $ fp </> "tmp_read.txt"+                fpathWrite <- Path.fromString $ fp </> "tmp_write.txt"                 writeFile fpathRead testDataLarge                 writeFile fpathWrite ""                 hr <- openFile fpathRead ReadMode@@ -158,7 +169,7 @@      go =         withSystemTempDirectory "fs_handle" $ \fp -> do-            let fpathRead = fp </> "tmp_read.txt"+            fpathRead <- Path.fromString $ fp </> "tmp_read.txt"             writeFile fpathRead testBinData             h <- openFile fpathRead ReadMode             ls <-
test/Streamly/Test/Network/Inet/TCP.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Test.Network.Socket@@ -113,7 +112,7 @@ validateOnPort = monadicIO $ do     res <- run $ do         ls2 <--            execute TCP.acceptorOnPort basePort defaultChunkSize handlerRW+            execute TCP.acceptor basePort defaultChunkSize handlerRW         let dataChunk = take defaultChunkSize testDataSource         Stream.eqBy (==) (Stream.fromList dataChunk) ls2     assert res@@ -123,7 +122,7 @@     res <- run $ do         ls2 <-             execute-                TCP.acceptorOnPortLocal+                TCP.acceptorLocal                 (basePort + 1)                 defaultChunkSize                 handlerRW
test/Streamly/Test/Network/Socket.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wno-deprecations #-}  -- | -- Module      : Streamly.Test.Network.Socket@@ -87,7 +86,7 @@ server :: PortNumber -> MVar () -> (Socket -> IO ()) -> IO () server port sem handler = do     putMVar sem ()-    Stream.unfold TCP.acceptorOnPort port+    Stream.unfold TCP.acceptor port         & Stream.mapM (Socket.forSocketM handler)         & Stream.fold Fold.drain
test/Streamly/Test/Prelude/Concurrent.hs view
@@ -490,10 +490,13 @@                    replicate 2000 $ S.fromEffect $ threadDelay 1000000)         `shouldReturn` () +-- Hanging on macOS CI+#ifdef DEVBUILD     it "aheadly crosses thread limit (4000 threads)" $         S.drain (fromAhead $ fold $                    replicate 4000 $ S.fromEffect $ threadDelay 1000000)         `shouldReturn` ()+#endif  #ifdef DEVBUILD     describe "restricts concurrency and cleans up extra tasks" $ do
test/Streamly/Test/Prelude/Serial.hs view
@@ -25,7 +25,6 @@ import Data.Maybe ( isJust, fromJust ) import Data.Word (Word8) import Data.Semigroup (Sum(..), getSum)-import Foreign.Storable (Storable) import Streamly.Internal.Data.MutByteArray (Unbox) import Test.Hspec.QuickCheck import Test.QuickCheck@@ -80,11 +79,11 @@     (a -> Bool) -> FL.Fold m a b -> S.Stream m a -> S.Stream m b splitOnSuffix predicate f = S.foldMany (FL.takeEndBy_ predicate f) -splitOnSeq' :: (MonadIO m, Unbox a, Storable a, Enum a, Eq a) =>+splitOnSeq' :: (MonadIO m, Unbox a, Enum a, Eq a) =>     A.Array a -> FL.Fold m a b -> S.Stream m a -> S.Stream m b splitOnSeq' patt f m = IS.foldManyPost (FL.takeEndBySeq_ patt f) m -splitOnSuffixSeq' :: (MonadIO m, Unbox a, Storable a, Enum a, Eq a) =>+splitOnSuffixSeq' :: (MonadIO m, Unbox a, Enum a, Eq a) =>     A.Array a -> FL.Fold m a b -> S.Stream m a -> S.Stream m b splitOnSuffixSeq' patt f m = S.foldMany (FL.takeEndBySeq_ patt f) m @@ -154,7 +153,7 @@         splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs)  splitterProperties ::-       forall a. (Arbitrary a, Eq a, Show a, Storable a, Unbox a, Enum a)+       forall a. (Arbitrary a, Eq a, Show a, Unbox a, Enum a)     => a     -> String     -> Spec@@ -221,17 +220,17 @@      where -    splitOnSeq_ xs ys =-        toList $ splitOnSeq' (A.fromList ys) FL.toList (S.fromList xs)+    splitOnSeq_ xs pat =+        toList $ splitOnSeq' (A.fromList pat) FL.toList (S.fromList xs) -    splitOnSuffixSeq_ xs ys =-        toList $ splitOnSuffixSeq' (A.fromList ys) FL.toList (S.fromList xs)+    splitOnSuffixSeq_ xs pat =+        toList $ splitOnSuffixSeq' (A.fromList pat) FL.toList (S.fromList xs) -    splitOn_ xs ys =-        toList $ splitOn (== (head ys)) FL.toList (S.fromList xs)+    splitOn_ xs pat =+        toList $ splitOn (== (head pat)) FL.toList (S.fromList xs) -    splitOnSuffix_ xs ys =-        toList $ splitOnSuffix (== (head ys)) FL.toList (S.fromList xs)+    splitOnSuffix_ xs pat =+        toList $ splitOnSuffix (== (head pat)) FL.toList (S.fromList xs)      intercalateSuffix xs yss = intercalate xs yss ++ xs
test/Streamly/Test/Prelude/WAsync.hs view
@@ -145,7 +145,7 @@      describe "Stream transform and combine operations" $ do         wAsyncOps $ transformCombineOpsCommon S.fromFoldable "wAsyncly" sortEq-        wAsyncOps $ transformCombineOpsCommon folded "wAsyncly" sortEq+        wAsyncOps $ transformCombineOpsCommon folded "wAsyncly folded" sortEq      describe "Stream elimination operations" $ do         wAsyncOps $ eliminationOps S.fromFoldable "wAsyncly"
test/Streamly/Test/Unicode/Char.hs view
@@ -72,7 +72,7 @@ checkNFKD (c1, c2, c3, c4, c5) =     checkOp "toNFKD" NFKD $ map (c5,) [c1, c2, c3, c4, c5] -splitOn predicate f = S.foldManyPost (FL.takeEndBy_ predicate f)+splitOn predicate f = S.foldMany1 (FL.takeEndBy_ predicate f)  checkAllTestCases :: Int -> String -> IO () checkAllTestCases lineno line = do
test/Streamly/Test/Unicode/Parser.hs view
@@ -15,7 +15,6 @@  import qualified Data.Scientific as Scientific import qualified Streamly.Data.Stream as Stream-import qualified Streamly.Internal.Data.Stream as Stream (parseBreak) import qualified Streamly.Unicode.Parser as Unicode import qualified Streamly.Internal.Unicode.Parser as Parser import qualified Test.Hspec as H@@ -102,9 +101,10 @@     x <- run $ f s     case x of         Right _ -> assert False-        Left (ParseError err) -> if err == msg-                                then assert (err == msg)-                                else trace err (assert (err == msg))+        Left (ParseError err) ->+            if err == msg+            then assert (err == msg)+            else trace err (assert (err == msg))  remainingStreamDouble :: String -> [String] remainingStreamDouble x =
test/Streamly/Test/Unicode/Stream.hs view
@@ -2,8 +2,9 @@  module Streamly.Test.Unicode.Stream (main) where +import Control.Monad (when) import Data.Char (ord, chr)-import Data.Word (Word8)+import Data.Word (Word8, Word16) import Test.QuickCheck     ( Property     , forAll@@ -16,9 +17,11 @@     , vectorOf     , choose     )-import Test.QuickCheck.Monadic (run, monadicIO, assert)+import Test.QuickCheck.Monadic (run, monadicIO, assert, PropertyM)+import Streamly.Data.Stream (Stream)  import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Data.Stream as Stream import qualified Streamly.Internal.Data.Array.Stream as AS import qualified Streamly.Internal.Data.Stream as Stream@@ -39,13 +42,23 @@ #endif -} +assertEq :: (Eq a, Show a) => a -> a -> PropertyM IO ()+assertEq a b = do+    when (a /= b) $ run $ do+        putStrLn $ "A: " ++ show a+        putStrLn $ "B: " ++ show b+    assert (a == b)+ -- Use quickcheck-unicode instead? genUnicode :: Gen String genUnicode = listOf arbitraryUnicodeChar -genWord8 :: Gen [Word8]-genWord8 = listOf arbitrary+genWord8List :: Gen [Word8]+genWord8List = listOf arbitrary +genListOfW8List :: Gen [[Word8]]+genListOfW8List = listOf (listOf arbitrary)+ propDecodeEncodeId' :: Property propDecodeEncodeId' =     forAll genUnicode $ \list ->@@ -54,6 +67,33 @@             chrs <- run $ Stream.toList $ SS.decodeUtf8' wrds             assert (chrs == list) +propDecodeEncodeUtf16Id+    :: (Stream IO Char -> Stream IO Word16)+    -> (Stream IO Word16 -> Stream IO Char)+    -> Property+propDecodeEncodeUtf16Id encoder decoder =+    forAll genUnicode $ \list ->+        monadicIO $ do+            let wrds = encoder $ Stream.fromList list+            chrs <- run $ Stream.toList $ decoder wrds+            assertEq chrs list++propMkEvenW8Chunks :: Property+propMkEvenW8Chunks =+    forAll genListOfW8List $ \list ->+        monadicIO $ do+            list1 <-+                run $ Stream.toList+                    $ fmap A.toList+                    $ IUS.mkEvenW8Chunks+                    $ fmap A.fromList $ Stream.fromList list+            let concatedList = concat list+                concatedList1 = concat list1+            assert (and (map (even . length) list1))+            if (odd (length concatedList))+            then assertEq concatedList1 (init concatedList)+            else assertEq concatedList1 concatedList+ -- XXX need to use invalid characters propDecodeEncodeId :: Property propDecodeEncodeId =@@ -61,15 +101,15 @@         monadicIO $ do             let wrds = SS.encodeUtf8 $ Stream.fromList list             chrs <- Stream.toList $ SS.decodeUtf8 wrds-            assert (chrs == list)+            assertEq chrs list  propDecodeEncodeIdArrays :: Property propDecodeEncodeIdArrays =     forAll genUnicode $ \list ->         monadicIO $ do-            let wrds = Stream.chunksOf 8 $ SS.encodeUtf8' $ Stream.fromList list+            let wrds = Array.chunksOf 8 $ SS.encodeUtf8' $ Stream.fromList list             chrs <- Stream.toList $ IUS.decodeUtf8Chunks wrds-            assert (chrs == list)+            assertEq chrs list  unicodeTestData :: [Char] unicodeTestData = "z\72150\83468;L$Wz| ?_i/J ."@@ -86,7 +126,7 @@                             $ SS.encodeLatin1                             $ Stream.fromList list                 lst <- run $  Stream.toList wrds-                assert (list == lst)+                assertEq list lst  propUnicodeToLatin1 :: Property propUnicodeToLatin1 =@@ -96,7 +136,7 @@                     $ SS.encodeLatin1                     $ Stream.fromList unicodeTestData         lst <- run $ Stream.toList wrds-        assert (latin1TestData == lst)+        assertEq latin1TestData lst  propUnicodeToLatin1' :: Property propUnicodeToLatin1' =@@ -106,7 +146,7 @@                     $ SS.encodeLatin1'                     $ Stream.fromList unicodeTestData         lst <- run $ Stream.toList wrds-        assert (latin1TestData == lst)+        assertEq latin1TestData lst  testLines :: Property testLines =@@ -116,17 +156,17 @@                 $ fmap A.toList                 $ IUA.lines                 $ Stream.fromList list-            assert (xs == lines list)+            assertEq xs (lines list)  testLinesArray :: Property testLinesArray =-    forAll genWord8 $ \list ->+    forAll genWord8List $ \list ->         monadicIO $ do             xs <- Stream.toList                     $ fmap A.toList                     $ AS.splitOnSuffix 10                     $ Stream.fromPure (A.fromList list)-            assert (xs == map (map (fromIntegral . ord))+            assertEq xs (map (map (fromIntegral . ord))                               (lines (map (chr .  fromIntegral) list)))  testWords :: Property@@ -137,7 +177,7 @@                 $ Stream.map A.toList                 $ IUA.words                 $ Stream.fromList list-            assert (xs == words list)+            assertEq xs (words list)  testUnlines :: Property testUnlines =@@ -147,7 +187,7 @@               $ IUA.unlines               $ IUA.lines               $ Stream.fromList list-          assert (xs == unlines (lines list))+          assertEq xs (unlines (lines list))  testUnwords :: Property testUnwords =@@ -158,7 +198,7 @@               $ IUA.unwords               $ IUA.words               $ Stream.fromList list-          assert (xs == unwords (words list))+          assertEq xs (unwords (words list))  moduleName :: String moduleName = "Unicode.Stream"@@ -183,6 +223,13 @@         prop             "Streamly.Data.String.unwords . Streamly.Data.String.words == unwords . words"             testUnwords++    H.describe "UTF16 - Encoding / Decoding" $ do+        prop "decodeUtf16le' . encodeUtf16le' == id"+             (propDecodeEncodeUtf16Id IUS.encodeUtf16le' IUS.decodeUtf16le')+        prop "decodeUtf16le . encodeUtf16le == id"+             (propDecodeEncodeUtf16Id IUS.encodeUtf16le' IUS.decodeUtf16le)+        prop "mkEvenW8Chunks" propMkEvenW8Chunks      H.describe "Latin1 - Encoding / Decoding" $ do         prop "ASCII to Latin1" propASCIIToLatin1
test/lib/Streamly/Test/Common.hs view
@@ -13,14 +13,18 @@     , checkListEqual     , chooseInt     , chooseDouble+    , performGCSweep     ) where -import Control.Monad (when)+import Control.Monad (when, void, replicateM_) import Control.Monad.IO.Class (MonadIO(..)) import Data.List ((\\))+import System.Mem (performMajorGC) import Test.QuickCheck (Property, Gen, choose, counterexample) import Test.QuickCheck.Monadic (PropertyM, assert, monitor, monadicIO) +import qualified Streamly.Internal.Data.MutArray as MA+ equals     :: (Show a, Monad m)     => (a -> a -> Bool) -> a -> a -> PropertyM m ()@@ -64,3 +68,10 @@  chooseDouble :: (Double, Double) -> Gen Double chooseDouble = choose++-- XXX Move this to Streamly.Test.Array.Common?+performGCSweep :: Int -> Int -> IO ()+performGCSweep i j = do+  replicateM_ i $ do+      performMajorGC+      void $ MA.fromList ([0 .. j] :: [Int])
+ test/lib/Streamly/Test/Parser/Common.hs view
@@ -0,0 +1,178 @@+module Streamly.Test.Parser.Common+    ( Move(..)+    , jumpParser+    , chunkedTape+    , tape+    , tapeLen+    , expectedResult+    , expectedResultMany+    , parserSanityTests+    )+where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Internal.Data.Parser (ParseErrorPos(..))+import qualified Streamly.Internal.Data.Parser as P+import Test.Hspec++--------------------------------------------------------------------------------+-- Parser driver tests+--------------------------------------------------------------------------------++data Move+    = Consume Int+    | Custom (P.Step () ())+    deriving (Show)++jumpParser :: Monad m => [Move] -> P.Parser Int m [Int]+jumpParser jumps = P.Parser step initial done+    where+    initial = pure $ P.IPartial (jumps, [])++    step ([], buf) _ = pure $ P.SDone 0 (reverse buf)+    step (action:xs, buf) a =+        case action of+            Consume n+                | n == 1 -> pure $ P.SContinue 1 (xs, a:buf)+                | n > 0 -> pure $ P.SContinue 1 (Consume (n - 1) : xs, a:buf)+                | otherwise -> error "Cannot consume <= 0"+            Custom (P.SPartial i ()) -> pure $ P.SPartial i (xs, buf)+            Custom (P.SContinue i ()) -> pure $ P.SContinue i (xs, buf)+            Custom (P.SDone i ()) -> pure $ P.SDone i (reverse buf)+            Custom (P.SError err) -> pure $ P.SError err++    done ([], buf) = pure $ P.FDone 0 (reverse buf)+    done (action:xs, buf) =+        case action of+            Consume _ -> pure $ P.FError "INCOMPLETE"+            Custom (P.SPartial i ()) -> pure $ P.FContinue i (xs, buf)+            Custom (P.SContinue i ()) -> pure $ P.FContinue i (xs, buf)+            Custom (P.SDone i ()) -> pure $ P.FDone i (reverse buf)+            Custom (P.SError err) -> pure $ P.FError err++chunkedTape :: [[Int]]+chunkedTape = Prelude.map (\x -> [x..(x+9)]) [1, 11 .. 91]++tape :: [Int]+tape = concat chunkedTape++tapeLen :: Int+tapeLen = length tape++expectedResult :: [Move] -> [Int] -> (Either ParseErrorPos [Int], [Int])+expectedResult moves inp = go 0 0 [] moves+    where+    inpLen = length inp++    slice off len = Prelude.take len . Prelude.drop off+    slice_ = Prelude.drop++    -- i = Index of inp head+    -- j = Minimum index of inp head+    go i j ys [] = (Right ys, slice_ (max i j) inp)+    go i j ys ((Consume n):xs)+        | i + n > inpLen = (Left (ParseErrorPos inpLen "INCOMPLETE"), drop j inp)+        | otherwise =+            go (i + n) j (ys ++ slice i n inp) xs+    go i j ys ((Custom step):xs)+        | i > inpLen = error "i > inpLen"+        | otherwise =+              case step of+                  P.SPartial n () -> go (i + n) (max j (i + n)) ys xs+                  P.SContinue n () -> go (i + n) j ys xs+                  P.SDone n () -> (Right ys, slice_ (max (i + n) j) inp)+                  P.SError err -> (Left (ParseErrorPos (i + 1) err), slice_ j inp)++expectedResultMany :: [Move] -> [Int] -> [Either ParseErrorPos [Int]]+expectedResultMany = go 0+    where+    go _ _ [] = []+    go off moves inp =+        let (res, rest) = expectedResult moves inp+            consumed = length inp - length rest+         in+           case res of+               Left (ParseErrorPos relOff err) ->+                   [Left (ParseErrorPos (off + relOff) err)]+               Right val -> Right val : go (off + consumed) moves rest++createPaths :: [a] -> [[a]]+createPaths xs =+    Prelude.map (`Prelude.take` xs) [1..length xs]++parserSanityTests :: String -> ([Move] -> SpecWith ()) -> SpecWith ()+parserSanityTests desc testRunner =+    describe desc $ do+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen + 1)+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Custom (P.SError "Message0")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 10+                , Custom (P.SPartial 1 ())+                , Consume 10+                , Custom (P.SPartial 0 ())+                , Consume 10+                , Custom (P.SPartial (-10) ())+                , Consume 10+                , Custom (P.SContinue 1 ())+                , Consume 10+                , Custom (P.SContinue 0 ())+                , Consume 10+                , Custom (P.SContinue (-10) ())+                , Custom (P.SError "Message1")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 10+                , Custom (P.SContinue 1 ())+                , Consume 10+                , Custom (P.SContinue 0 ())+                , Consume 10+                , Custom (P.SContinue (-10) ())+                , Consume 10+                , Custom (P.SDone 1 ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SDone 0 ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SError "Message2")+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume 20+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-10) ())+                , Custom (P.SDone (-4) ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen - 1)+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-9) ())+                , Custom (P.SDone (-4) ())+                ]+        Prelude.mapM_ testRunner $+            createPaths+                [ Consume (tapeLen - 1)+                , Custom (P.SContinue 1 ())+                , Custom (P.SContinue (-9) ())+                , Custom (P.SError "Message3")+                ]
test/lib/Streamly/Test/Prelude/Common.hs view
@@ -1,3 +1,4 @@+{-# Language NoMonoLocalBinds #-} {-# OPTIONS_GHC -Wno-deprecations #-} -- XXX We are using head/tail at one place #if __GLASGOW_HASKELL__ >= 908@@ -102,6 +103,8 @@ import Control.Monad.Catch (throwM, MonadThrow) import Data.IORef ( IORef, atomicModifyIORef', modifyIORef', newIORef                   , readIORef, writeIORef)+import Data.Foldable+    (elem, foldl, foldMap, foldr, length, maximum, minimum, null, product, sum) import Data.List     ( delete     , deleteBy@@ -144,6 +147,7 @@ import qualified Data.Map.Strict as Map  import Streamly.Test.Common+import Prelude hiding (Foldable(..))  maxStreamLen :: Int maxStreamLen = 1000
test/streamly-tests.cabal view
@@ -50,8 +50,6 @@ -------------------------------------------------------------------------------  common compile-options-    default-language: Haskell2010-     if os(darwin)       cpp-options:    -DCABAL_OS_DARWIN @@ -92,10 +90,23 @@       cpp-options: -DINCLUDE_FLAKY_TESTS  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.+    if impl(ghc >= 9.10)+      default-language: GHC2024++    if impl(ghc >= 9.2) && impl(ghc < 9.10)+      default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions: StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -107,24 +118,18 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         TupleSections-        TypeFamilies-        ViewPatterns -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,-        -- otherwise TypeFamilies will enable it again.+        -- Not in GHC2024+        CPP+        MagicHash+        PatternSynonyms+        RecordWildCards         NoMonoLocalBinds -        -- UndecidableInstances -- Does not show any perf impact-        -- UnboxedTuples        -- interferes with (#.)- common threading-options   ghc-options:  -threaded                 -with-rtsopts=-N@@ -145,7 +150,7 @@ common test-dependencies   build-depends:         streamly-core-      , base              >= 4.9   && < 4.20+      , base              >= 4.9   && < 4.22       , containers        >= 0.5   && < 0.8       , exceptions        >= 0.8   && < 0.11       , ghc@@ -153,13 +158,13 @@       , mtl               >= 2.2   && < 2.3.2       , random            >= 1.0.0 && < 1.3       , transformers      >= 0.4   && < 0.7-      , QuickCheck        >= 2.13  && < 2.15+      , QuickCheck        >= 2.13  && < 2.16       , directory         >= 1.2.2 && < 1.4-      , filepath          >= 1.4.1 && < 1.5+      , filepath          >= 1.4.1 && < 1.6       , temporary         >= 1.3   && < 1.4-      , network           >= 3.1   && < 3.2+      , network           >= 3.1   && < 3.3       , scientific        >= 0.0   && < 0.4-      , template-haskell  >= 2.12  && < 2.22+      , template-haskell  >= 2.12  && < 2.24    if !flag(use-streamly-core)     build-depends: streamly@@ -181,7 +186,9 @@ library     import: lib-options, test-dependencies     hs-source-dirs: lib-    exposed-modules: Streamly.Test.Common+    exposed-modules:+        Streamly.Test.Common+        Streamly.Test.Parser.Common     if !flag(use-streamly-core)       exposed-modules: Streamly.Test.Prelude.Common     if flag(limit-build-mem)@@ -194,7 +201,10 @@ common test-options   import: lib-options         , threading-options-  ghc-options: -rtsopts -fno-ignore-asserts+  ghc-options:+    -rtsopts+    -with-rtsopts "-t"+    -fno-ignore-asserts   include-dirs: .   build-depends: streamly-tests @@ -208,27 +218,20 @@                -fmax-worker-args=16                -fspec-constr-recursive=16                -rtsopts+               -with-rtsopts "-t"                -fno-ignore-asserts   if flag(fusion-plugin) && !impl(ghcjs) && !impl(ghc < 8.6)     ghc-options: -fplugin Fusion.Plugin  ---------------------------------------------------------------------------------- Test suites in sorted order+-- Test suites in alphabetical order ------------------------------------------------------------------------------- --- The Streamly.Data.List needs to be fixed to enable this--- test-suite Data.List---   import: test-options---   type: exitcode-stdio-1.0---   main-is: Streamly/Test/Data/List.hs---   cpp-options:  -DUSE_STREAMLY_LIST---   if !flag(dev)---     buildable: False--test-suite Data.List.Base+test-suite Data.Array   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/List.hs+  main-is: Streamly/Test/Data/Array.hs+  ghc-options: -main-is Streamly.Test.Data.Array.main  test-suite Data.Array.Generic   import: test-options@@ -238,58 +241,80 @@   if flag(use-streamly-core)     buildable: False -test-suite Data.Array+test-suite Data.Array.Stream   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array.hs-  ghc-options: -main-is Streamly.Test.Data.Array.main+  main-is: Streamly/Test/Data/Array/Stream.hs+  if flag(use-streamly-core)+    buildable: False -test-suite Data.Stream+test-suite Data.Binary   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Stream.hs-  ghc-options: -main-is Streamly.Test.Data.Stream.main+  main-is: Streamly/Test/Serialize/Serializable.hs -test-suite Data.MutArray+test-suite Data.Fold   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/MutArray.hs-  ghc-options: -main-is Streamly.Test.Data.MutArray.main+  main-is: Streamly/Test/Data/Fold.hs -test-suite Data.Ring.Unboxed+test-suite Data.Fold.Window   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Ring/Unboxed.hs-  ghc-options: -main-is Streamly.Test.Data.Ring.Unboxed.main-  if flag(use-streamly-core)-    buildable: False+  main-is: Streamly/Test/Data/Fold/Window.hs+  ghc-options: -main-is Streamly.Test.Data.Fold.Window.main -test-suite Data.Unbox.Derive.Generic+-- The Streamly.Data.List needs to be fixed to enable this+-- test-suite Data.List+--   import: test-options+--   type: exitcode-stdio-1.0+--   main-is: Streamly/Test/Data/List.hs+--   cpp-options:  -DUSE_STREAMLY_LIST+--   if !flag(dev)+--     buildable: False++test-suite Data.List.Base   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Unbox.hs-  ghc-options: -main-is Streamly.Test.Data.Unbox.main+  main-is: Streamly/Test/Data/List.hs -test-suite Data.Unbox.Derive.TH+test-suite Data.MutArray   import: test-options   type: exitcode-stdio-1.0-  cpp-options: -DUSE_TH-  main-is: Streamly/Test/Data/Unbox.hs-  ghc-options: -main-is Streamly.Test.Data.Unbox.main+  main-is: Streamly/Test/Data/MutArray.hs+  ghc-options: -main-is Streamly.Test.Data.MutArray.main -test-suite Data.Serialize.Derive.TH+test-suite Data.Parser   import: test-options   type: exitcode-stdio-1.0-  cpp-options: -DUSE_SERIALIZE-  main-is: Streamly/Test/Data/Unbox.hs-  ghc-options: -main-is Streamly.Test.Data.Unbox.main+  main-is: Streamly/Test/Data/Parser.hs+  hs-source-dirs: .+  other-modules: Streamly.Test.Data.Parser.Common+  if flag(limit-build-mem)+    ghc-options: +RTS -M2000M -RTS -test-suite Data.Unbox.TH+test-suite Data.ParserK   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Unbox/TH.hs-  ghc-options: -main-is Streamly.Test.Data.Unbox.TH.main+  main-is: Streamly/Test/Data/ParserK.hs+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS +test-suite Data.RingArray+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/RingArray.hs+  ghc-options: -main-is Streamly.Test.Data.RingArray.main++test-suite Data.Scanl.Concurrent+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Scanl/Concurrent.hs+  ghc-options: -main-is Streamly.Test.Data.Scanl.Concurrent.main+  if flag(use-streamly-core)+    buildable: False++-- XXX Rename to MutByteArray test-suite Data.Serialize   import: test-options   type: exitcode-stdio-1.0@@ -302,6 +327,13 @@   if flag(limit-build-mem)     ghc-options: +RTS -M1500M -RTS +test-suite Data.Serialize.Derive.TH+  import: test-options+  type: exitcode-stdio-1.0+  cpp-options: -DUSE_SERIALIZE+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main+ test-suite Data.Serialize.ENABLE_constructorTagAsString   import: test-options   type: exitcode-stdio-1.0@@ -315,45 +347,75 @@   if flag(limit-build-mem)     ghc-options: +RTS -M1500M -RTS -test-suite Data.Array.Stream+test-suite Data.SmallArray   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Array/Stream.hs+  main-is: Streamly/Test/Data/SmallArray.hs+  ghc-options: -main-is Streamly.Test.Data.SmallArray.main+  if !flag(dev) || flag(use-streamly-core)+    buildable: False++test-suite Data.Stream+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.main+  if flag(limit-build-mem)+    ghc-options: +RTS -M1500M -RTS++test-suite Data.Stream.Concurrent+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Concurrent.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Concurrent.main   if flag(use-streamly-core)     buildable: False -test-suite Data.Fold+test-suite Data.Stream.Exception   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Fold.hs+  main-is: Streamly/Test/Data/Stream/Exception.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Exception.main -test-suite Data.Fold.Window+test-suite Data.Stream.Time   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Fold/Window.hs-  ghc-options: -main-is Streamly.Test.Data.Fold.Window.main+  main-is: Streamly/Test/Data/Stream/Time.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Time.main+  if flag(use-streamly-core)+    buildable: False -test-suite Data.Parser+test-suite Data.Stream.Rate+  import:always-optimized+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Data/Stream/Rate.hs+  ghc-options: -main-is Streamly.Test.Data.Stream.Rate.main+  if flag(dev)+    buildable: True+  else+    buildable: False+  if flag(use-streamly-core)+    buildable: False++-- XXX Rename to MutByteArray.Unbox+test-suite Data.Unbox.Derive.Generic   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Parser.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M4000M -RTS+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main -test-suite Data.ParserK+test-suite Data.Unbox.Derive.TH   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/ParserK.hs-  if flag(limit-build-mem)-    ghc-options: +RTS -M1500M -RTS+  cpp-options: -DUSE_TH+  main-is: Streamly/Test/Data/Unbox.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.main -test-suite Data.SmallArray+test-suite Data.Unbox.TH   import: test-options   type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/SmallArray.hs-  ghc-options: -main-is Streamly.Test.Data.SmallArray.main-  if !flag(dev) || flag(use-streamly-core)-    buildable: False+  main-is: Streamly/Test/Data/Unbox/TH.hs+  ghc-options: -main-is Streamly.Test.Data.Unbox.TH.main  test-suite Data.Unfold   import: test-options@@ -366,7 +428,7 @@   ghc-options: -main-is Streamly.Test.FileSystem.Event   main-is: Streamly/Test/FileSystem/Event.hs   other-modules: Streamly.Test.FileSystem.Event.Common-  if flag(use-streamly-core)+  if !((os(linux) && impl(ghc >= 9.4)) || os(darwin) || os(windows)) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Event.Darwin@@ -376,9 +438,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_DARWIN   ghc-options: -main-is Streamly.Test.FileSystem.Event.Darwin-  if !os(darwin)-    buildable: False-  if flag(use-streamly-core)+  if !os(darwin) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Event.Linux@@ -388,7 +448,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_LINUX   ghc-options: -main-is Streamly.Test.FileSystem.Event.Linux-  if !os(linux) || !flag(dev) || flag(use-streamly-core)+  if impl(ghc < 9.4) || !os(linux) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Event.Windows@@ -398,9 +458,7 @@   other-modules: Streamly.Test.FileSystem.Event.Common   cpp-options: -DFILESYSTEM_EVENT_WINDOWS   ghc-options: -main-is Streamly.Test.FileSystem.Event.Windows-  if !os(windows)-    buildable: False-  if flag(use-streamly-core)+  if !os(windows) || flag(use-streamly-core)     buildable: False  test-suite FileSystem.Handle@@ -411,6 +469,18 @@   if flag(use-streamly-core)     buildable: False +test-suite FileSystem.DirIO+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/FileSystem/DirIO.hs+  if flag(use-streamly-core)+    buildable: False+  build-depends:+      bench-test-lib+  -- Fix this test-suite for Windows+  if os(windows)+    buildable: False+ test-suite Network.Inet.TCP   import: lib-options   type: exitcode-stdio-1.0@@ -437,6 +507,39 @@   if flag(use-streamly-core)     buildable: False +test-suite Unicode.Char+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Char.hs+  ghc-options: -main-is Streamly.Test.Unicode.Char.main+  if flag(use-streamly-core) || !flag(dev)+    buildable: False++test-suite Unicode.Parser+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Parser.hs+  ghc-options: -main-is Streamly.Test.Unicode.Parser.main+  if flag(use-streamly-core)+    buildable: False++test-suite Unicode.Stream+  import: test-options+  type: exitcode-stdio-1.0+  main-is: Streamly/Test/Unicode/Stream.hs+  ghc-options: -main-is Streamly.Test.Unicode.Stream.main+  if flag(use-streamly-core)+    buildable: False++test-suite version-bounds+  import: test-options+  type: exitcode-stdio-1.0+  main-is: version-bounds.hs++-------------------------------------------------------------------------------+-- Deprecated+-------------------------------------------------------------------------------+ test-suite Prelude   import: test-options   type: exitcode-stdio-1.0@@ -461,14 +564,6 @@   if flag(use-streamly-core)     buildable: False -test-suite Data.Stream.Concurrent-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Data/Stream/Concurrent.hs-  ghc-options: -main-is Streamly.Test.Data.Stream.Concurrent.main-  if flag(use-streamly-core)-    buildable: False- test-suite Prelude.Concurrent   import: test-options   type: exitcode-stdio-1.0@@ -557,37 +652,3 @@   ghc-options: -main-is Streamly.Test.Prelude.ZipSerial.main   if flag(use-streamly-core)     buildable: False--test-suite Unicode.Stream-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Unicode/Stream.hs-  ghc-options: -main-is Streamly.Test.Unicode.Stream.main-  if flag(use-streamly-core)-    buildable: False--test-suite Unicode.Parser-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Unicode/Parser.hs-  ghc-options: -main-is Streamly.Test.Unicode.Parser.main-  if flag(use-streamly-core)-    buildable: False--test-suite Unicode.Char-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Unicode/Char.hs-  ghc-options: -main-is Streamly.Test.Unicode.Char.main-  if flag(use-streamly-core) || !flag(dev)-    buildable: False--test-suite Serialize.Serializable-  import: test-options-  type: exitcode-stdio-1.0-  main-is: Streamly/Test/Serialize/Serializable.hs--test-suite version-bounds-  import: test-options-  type: exitcode-stdio-1.0-  main-is: version-bounds.hs
test/test-runner/Main.hs view
@@ -10,23 +10,28 @@ import Targets (targets)  rtsOpts :: Bool -> String -> String -> String-rtsOpts relaxMem exeName target =+rtsOpts relaxMem exeName target = mkOpts <> " -t" -    if relaxMem-    then "-K16M -M1024M"-    else "-K8M -M64M " <> targetSpecific      where +    mkOpts =+        if relaxMem+        then "-K16M -M1024M"+        else "-K8M -M64M " <> targetSpecific+     targetSpecific =         case target of             -- XXX Data.Array.* heap requirement increased for GHC-8.10-            "Data.Array.Unboxed" -> "-M128M"+            "Data.Array" -> "-M128M"             "Data.Array.Generic" -> "-M128M"+            "Data.Stream.Rate" -> "-M512M"+            "Data.Serialize" -> "-M128M"+            "Data.Serialize.ENABLE_constructorTagAsString" -> "-M128M"             "Prelude.Rate" -> "-M512M"             -- For -O0 case writeChunks test fails, maybe we should have a             -- separate flag for O0 case?-            "FileSystem.Handle" -> "-K16M"+            "FileSystem.Handle" -> "-K16M -M128M"             _ -> ""  main :: IO ()