git.iko.soy/streamly
on master help sign in
Fix examples to use new names
dffb02fHarendra Kumar
examples/loops.hs+4−4
compare with master
unifiedsplit
@@ -26,12 +26,12 @@ main = do
26
26
27 putStrLn $ "\ninterleave:\n"
27 putStrLn $ "\ninterleave:\n"
28 runSerialT $ do
28 runSerialT $ do
29− x <- return 0 <> return 1 <=> return 100 <> return 101
29+ x <- (return 0 <> return 1) `interleave` (return 100 <> return 101)
30 liftIO $ print (x :: Int)
30 liftIO $ print (x :: Int)
31
31
32 putStrLn $ "\nParallel interleave:\n"
32 putStrLn $ "\nParallel interleave:\n"
33 runSerialT $ do
33 runSerialT $ do
34− x <- return 0 <> return 1 <|> return 100 <> return 101
34+ x <- (return 0 <> return 1) `parmerge` (return 100 <> return 101)
35 liftIO $ print (x :: Int)
35 liftIO $ print (x :: Int)
36
36
37 where
37 where
@@ -71,12 +71,12 @@ main = do
71 loopTailA :: Int -> SerialT IO Int
71 loopTailA :: Int -> SerialT IO Int
72 loopTailA x = do
72 loopTailA x = do
73 liftIO $ putStrLn "LoopTailA..."
73 liftIO $ putStrLn "LoopTailA..."
74− return x <| (if x < 3 then loopTailA (x + 1) else empty)
74+ return x `asyncmerge` (if x < 3 then loopTailA (x + 1) else empty)
75
75
76 loopHeadA :: Int -> SerialT IO Int
76 loopHeadA :: Int -> SerialT IO Int
77 loopHeadA x = do
77 loopHeadA x = do
78 liftIO $ putStrLn "LoopHeadA..."
78 liftIO $ putStrLn "LoopHeadA..."
79− (if x < 3 then loopHeadA (x + 1) else empty) <| return x
79+ (if x < 3 then loopHeadA (x + 1) else empty) `asyncmerge` return x
80
80
81-------------------------------------------------------------------------------
81-------------------------------------------------------------------------------
82-- Parallel (fairly scheduled, multi-threaded) stream generator loops
82-- Parallel (fairly scheduled, multi-threaded) stream generator loops
examples/nested-loops.hs+4−3
@@ -1,9 +1,9 @@
1−import Control.Applicative ((<|>), empty)
2import Control.Concurrent (myThreadId)
1import Control.Concurrent (myThreadId)
3import Control.Monad.IO.Class (liftIO)
2import Control.Monad.IO.Class (liftIO)
4import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
3import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
5import System.Random (randomIO)
4import System.Random (randomIO)
6import Streamly
5import Streamly
6+import Streamly.Prelude (nil)
7
7
8main = runSerialT $ do
8main = runSerialT $ do
9 liftIO $ hSetBuffering stdout LineBuffering
9 liftIO $ hSetBuffering stdout LineBuffering
@@ -15,8 +15,9 @@ main = runSerialT $ do
15
15
16 where
16 where
17
17
18+ loop :: String -> Int -> SerialT IO String
18 loop name n = do
19 loop name n = do
19 rnd <- liftIO (randomIO :: IO Int)
20 rnd <- liftIO (randomIO :: IO Int)
20 let result = (name ++ show rnd)
21 let result = (name ++ show rnd)
21− repeat = if n > 1 then loop name (n - 1) else empty
22+ repeat = if n > 1 then loop name (n - 1) else nil
22− in (return result) <|> repeat
23+ in (return result) `parmerge` repeat
examples/parallel-loops.hs+3−3
@@ -1,4 +1,3 @@
1−import Control.Applicative ((<|>))
2import Control.Concurrent (myThreadId, threadDelay)
1import Control.Concurrent (myThreadId, threadDelay)
3import Control.Monad.IO.Class (liftIO)
2import Control.Monad.IO.Class (liftIO)
4import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
3import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
@@ -7,14 +6,15 @@ import Streamly
7
6
8main = runSerialT $ do
7main = runSerialT $ do
9 liftIO $ hSetBuffering stdout LineBuffering
8 liftIO $ hSetBuffering stdout LineBuffering
10− x <- loop "A" <|> loop "B"
9+ x <- loop "A" `parmerge` loop "B"
11 liftIO $ myThreadId >>= putStr . show
10 liftIO $ myThreadId >>= putStr . show
12 >> putStr " "
11 >> putStr " "
13 >> print x
12 >> print x
14
13
15 where
14 where
16
15
16+ loop :: String -> SerialT IO (String, Int)
17 loop name = do
17 loop name = do
18 liftIO $ threadDelay 1000000
18 liftIO $ threadDelay 1000000
19 rnd <- liftIO (randomIO :: IO Int)
19 rnd <- liftIO (randomIO :: IO Int)
20− return (name, rnd) <|> loop name
20+ return (name, rnd) `parmerge` loop name
src/Streamly/Examples/AcidRainGame.hs+1−1
@@ -28,7 +28,7 @@ acidRain = cycle1 $ liftIO (threadDelay 1000000) >> return (Harm 1)
28
28
29game :: (MonadAsync m, MonadState Int m) => SerialT m ()
29game :: (MonadAsync m, MonadState Int m) => SerialT m ()
30game = do
30game = do
31− event <- userAction <|> acidRain
31+ event <- userAction `parmerge` acidRain
32 case event of
32 case event of
33 Harm n -> modify $ \h -> h - n
33 Harm n -> modify $ \h -> h - n
34 Heal n -> modify $ \h -> h + n
34 Heal n -> modify $ \h -> h + n
src/Streamly/Examples/CirclingSquare.hs+1−1
@@ -87,4 +87,4 @@ circlingSquare :: IO ()
87circlingSquare = do
87circlingSquare = do
88 sdlInit
88 sdlInit
89 cref <- newIORef (0,0)
89 cref <- newIORef (0,0)
90− runSerialT $ liftIO (updateController cref) <|> liftIO (updateDisplay cref)
90+ runSerialT $ liftIO (updateController cref) `parmerge` liftIO (updateDisplay cref)
src/Streamly/Examples/ListDirRecursive.hs+9−10
@@ -1,19 +1,18 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−
3module Streamly.Examples.ListDirRecursive where
1module Streamly.Examples.ListDirRecursive where
4
2
3+import Control.Monad.IO.Class (liftIO)
5import Path.IO (listDir, getCurrentDir)
4import Path.IO (listDir, getCurrentDir)
6import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
5import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))
7−import Streamly
6+import Streamly (runAsyncT)
8
7
8+-- | This example demonstrates that there is little difference between regular
9+-- IO code and concurrent streamly code. You can just remove 'runAsyncT' and
10+-- this is your regular IO code.
9listDirRecursive :: IO ()
11listDirRecursive :: IO ()
10listDirRecursive = do
12listDirRecursive = do
11− liftIO $ hSetBuffering stdout LineBuffering
13+ hSetBuffering stdout LineBuffering
12− runSerialT $ getCurrentDir >>= readdir
14+ runAsyncT $ getCurrentDir >>= readdir
13 where readdir d = do
15 where readdir d = do
14− (ds, fs) <- lift $ listDir d
16+ (ds, fs) <- liftIO $ listDir d
15 liftIO $ mapM_ putStrLn $ map show fs ++ map show ds
17 liftIO $ mapM_ putStrLn $ map show fs ++ map show ds
16− --foldWith (<>) $ map readdir ds -- serial
18+ foldMap readdir ds
17− --foldWith (<=>) $ map readdir ds -- serial interleaved
18− foldWith (<|) $ map readdir ds -- concurrent left biased
19− --foldWith (<|>) $ map readdir ds -- concurrent interleaved
src/Streamly/Examples/SearchEngineQuery.hs+5−3
@@ -7,13 +7,15 @@ import Network.HTTP.Simple
7searchEngineQuery :: IO ()
7searchEngineQuery :: IO ()
8searchEngineQuery = do
8searchEngineQuery = do
9 putStrLn "Using parallel alternative"
9 putStrLn "Using parallel alternative"
10− runSerialT $ google <|> bing <|> duckduckgo
10+ runParallelT $ google <> bing <> duckduckgo
11
11
12 putStrLn "\nUsing parallel applicative zip"
12 putStrLn "\nUsing parallel applicative zip"
13− runZipAsync $ (,,) <$> pure google <*> pure bing <*> pure duckduckgo
13+ runZipAsync $ (,,) <$> google <*> bing <*> duckduckgo
14
14
15 where
15 where
16+ get :: IsStream t => String -> t IO ()
17+ google, bing, duckduckgo :: IsStream t => t IO ()
16− get s = liftIO (httpNoBody (parseRequest_ s) >> putStrLn (show s))
18+ get s = adapt . serially $ liftIO (httpNoBody (parseRequest_ s) >> putStrLn (show s))
17 google = get "https://www.google.com/search?q=haskell"
19 google = get "https://www.google.com/search?q=haskell"
18 bing = get "https://www.bing.com/search?q=haskell"
20 bing = get "https://www.bing.com/search?q=haskell"
19 duckduckgo = get "https://www.duckduckgo.com/?q=haskell"
21 duckduckgo = get "https://www.duckduckgo.com/?q=haskell"