on master help sign in
Move parallel loops test to Prelude.
commit7de5e0e53c43614265bdd6f120079f67835b4604 authorpranaysashank <pranaysashank@composewell.com> dateWed 14 Oct 2020, 11:37 (6 years ago) parent16db9cf
3 files changed+25−38
streamly.cabal−11 test/Streamly/Test/Prelude.hs+25 test/parallel-loops.hs−27
streamly.cabal−11
@@ -817,17 +817,6 @@ test-suite string-test
817817 , hspec >= 2.0 && < 3
818818 default-language: Haskell2010
819819
820−test-suite parallel-loops
821− import: test-options
822− type: exitcode-stdio-1.0
823− default-language: Haskell2010
824− main-is: parallel-loops.hs
825− hs-source-dirs: test
826− build-Depends:
827− streamly
828− , base >= 4.9 && < 5
829− , random >= 1.0.0 && < 2
830−
831820test-suite version-bounds
832821 import: test-options
833822 type: exitcode-stdio-1.0
test/Streamly/Test/Prelude.hs+25
@@ -229,6 +229,7 @@ mixedOpsAheadly =
229229 return (x1 + y1 + z1)
230230 return (x + y + z)
231231
232+-- XXX Merge both the loops.
232233nestedLoops :: IO ()
233234nestedLoops = S.drain $ do
234235 S.yieldM $ hSetBuffering stdout LineBuffering
@@ -249,6 +250,29 @@ nestedLoops = S.drain $ do
249250 repeatIt = if n > 1 then loop name (n - 1) else S.nil
250251 in return result `S.wAsync` repeatIt
251252
253+parallelLoops :: IO ()
254+parallelLoops = do
255+ hSetBuffering stdout LineBuffering
256+ S.drain $ do
257+ x <- S.take 10 $ loop "A" `S.parallel` loop "B"
258+ S.yieldM $ myThreadId >>= putStr . show
259+ >> putStr " got "
260+ >> print x
261+
262+ where
263+
264+ -- we can just use
265+ -- parallely $ cycle1 $ yieldM (...)
266+ loop :: String -> SerialT IO (String, Int)
267+ loop name = do
268+ S.yieldM $ threadDelay 1000000
269+ rnd <- S.yieldM (randomIO :: IO Int)
270+ S.yieldM $ myThreadId >>= putStr . show
271+ >> putStr " yielding "
272+ >> print rnd
273+ return (name, rnd) `S.parallel` loop name
274+
275+
252276main :: IO ()
253277main = hspec $ H.parallel $ do
254278 describe "Filtering" $ do
@@ -266,6 +290,7 @@ main = hspec $ H.parallel $ do
266290 describe "Simple MonadError and MonadThrow" simpleMonadError
267291
268292 it "Nested loops" nestedLoops
293+ it "Parallel loops" parallelLoops
269294 {-
270295 describe "Composed MonadError serially" $ composeWithMonadError serially
271296 describe "Composed MonadError wSerially" $ composeWithMonadError wSerially
test/parallel-loops.hsdeleted−27
@@ -1,27 +0,0 @@
1−import Control.Concurrent (myThreadId, threadDelay)
2−import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
3−import System.Random (randomIO)
4−import Streamly.Prelude
5−import qualified Streamly.Prelude as S
6−
7−main :: IO ()
8−main = do
9− hSetBuffering stdout LineBuffering
10− S.drain $ do
11− x <- S.take 10 $ loop "A" `parallel` loop "B"
12− S.yieldM $ myThreadId >>= putStr . show
13− >> putStr " got "
14− >> print x
15−
16− where
17−
18− -- we can just use
19− -- parallely $ cycle1 $ yieldM (...)
20− loop :: String -> Serial (String, Int)
21− loop name = do
22− S.yieldM $ threadDelay 1000000
23− rnd <- S.yieldM (randomIO :: IO Int)
24− S.yieldM $ myThreadId >>= putStr . show
25− >> putStr " yielding "
26− >> print rnd
27− return (name, rnd) `parallel` loop name