5fe13b0 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

update examples and documentation

5fe13b0Harendra Kumar8 years ago

examples/MergeSort.hs+11−27

compare with master

unifiedsplit

@@ -1,40 +1,24 @@

1{-# LANGUAGE FlexibleContexts #-}

3+-- | This example generates two streams sorted in ascending order and merges

4+-- them in ascending order, concurrently.

5+--

6+-- Compile with '-threaded -with-rtsopts "-N"' GHC options to use the

7+-- parallelism.

3import Data.Word

9import Data.Word

4import System.Random (getStdGen, randoms)

10import System.Random (getStdGen, randoms)

5import Data.List (sort)

11import Data.List (sort)

12+import Data.Ord (compare)

13+

6import Streamly

14import Streamly

7−import Streamly.Prelude (yieldM)

8−import qualified Streamly.Prelude as A

15+import qualified Streamly.Prelude as S

10getSorted :: Serial Word16

17getSorted :: Serial Word16

11getSorted = do

18getSorted = do

12− g <- yieldM getStdGen

19+ g <- S.yieldM getStdGen

13 let ls = take 100000 (randoms g) :: [Word16]

20 let ls = take 100000 (randoms g) :: [Word16]

14 foldMap return (sort ls)

21 foldMap return (sort ls)

16−-- | merge two streams generating the elements from each in parallel

17−mergeAsync :: Ord a => Serial a -> Serial a -> Serial a

18−mergeAsync a b = do

19− x <- yieldM $ mkAsync a

20− y <- yieldM $ mkAsync b

21− merge x y

22−

23−merge :: Ord a => Serial a -> Serial a -> Serial a

24−merge a b = do

25− a1 <- yieldM $ A.uncons a

26− case a1 of

27− Nothing -> b

28− Just (x, ma) -> do

29− b1 <- yieldM $ A.uncons b

30− case b1 of

31− Nothing -> return x <> ma

32− Just (y, mb) ->

33− if y < x

34− then return y <> merge (return x <> ma) mb

35− else return x <> merge ma (return y <> mb)

36−

37main :: IO ()

23main :: IO ()

38−main = do

24+main = S.last (S.mergeAsyncBy compare getSorted getSorted) >>= print

39− xs <- A.toList $ mergeAsync getSorted getSorted

40− print $ length xs

src/Streamly/Tutorial.hs+44−27

@@ -87,8 +87,9 @@ module Streamly.Tutorial

87 -- *** Parallel Asynchronous Composition ('Parallel')

88 -- $parallel

90+ -- XXX we should deprecate and remove the mkAsync API

90− -- *** Custom composition

91+ -- Custom composition

91− -- $custom

92+ -- custom

93 -- ** Monoid Style

94 -- ** Monoid Style

94 -- $monoid

95 -- $monoid

@@ -892,6 +893,7 @@ import Control.Monad.Trans.Class (MonadTrans (lift))

892-- number of streams, as it will lead to an infinite sized scheduling queue.

893-- number of streams, as it will lead to an infinite sized scheduling queue.

893--

894--

894

895

896+-- XXX to be removed

895-- $custom

897-- $custom

896--

898--

897-- The 'mkAsync' API can be used to create references to asynchronously running

899-- The 'mkAsync' API can be used to create references to asynchronously running

@@ -1439,7 +1441,9 @@ import Control.Monad.Trans.Class (MonadTrans (lift))

1439-- and operators instead of the ugly pragmas.

1441-- and operators instead of the ugly pragmas.

1440--

1442--

1441-- For more concurrent programming examples see,

1443-- For more concurrent programming examples see,

1444+-- <src/examples/ListDir.hs ListDir.hs>,

1445+-- <src/examples/MergeSort.hs MergeSort.hs> and

1442−-- "ListDir.hs", "MergeSort.hs" and "SearchQuery.hs" in the examples directory.

1446+-- <src/examples/SearchQuery.hs SearchQuery.hs> in the examples directory.

1443

1447

1444-- $reactive

1448-- $reactive

1445--

1449--

@@ -1462,52 +1466,65 @@ import Control.Monad.Trans.Class (MonadTrans (lift))

1462-- {-\# LANGUAGE FlexibleContexts #-}

1466-- {-\# LANGUAGE FlexibleContexts #-}

1463--

1467--

1464-- import "Streamly"

1468-- import "Streamly"

1465−-- import Streamly.Prelude as S

1469+-- import "Streamly.Prelude" as S

1466−-- import Control.Monad (when)

1470+-- import Control.Monad (void, when)

1467−-- import Control.Monad.IO.Class (MonadIO(..))

1471+-- import Control.Monad.IO.Class (MonadIO(liftIO))

1468−-- import Control.Monad.State (MonadState, get, modify, runStateT)

1472+-- import Control.Monad.State (MonadState, get, modify, runStateT, put)

1469--

1473--

1470−-- data Event = Harm Int | Heal Int | Quit deriving (Show)

1474+-- data Event = Quit | Harm Int | Heal Int deriving (Show)

1471--

1475--

1472-- userAction :: MonadAsync m => 'SerialT' m Event

1476-- userAction :: MonadAsync m => 'SerialT' m Event

1473−-- userAction = S.repeatM $ liftIO askUser

1477+-- userAction = S.'repeatM' $ liftIO askUser

1474-- where

1478-- where

1475-- askUser = do

1479-- askUser = do

1476-- command <- getLine

1480-- command <- getLine

1477-- case command of

1481-- case command of

1478-- "potion" -> return (Heal 10)

1482-- "potion" -> return (Heal 10)

1483+-- "harm" -> return (Harm 10)

1479−-- "quit" -> return Quit

1484+-- "quit" -> return Quit

1480−-- _ -> putStrLn "What?" >> askUser

1485+-- _ -> putStrLn "Type potion or harm or quit" >> askUser

1486+--

1487+-- acidRain :: MonadAsync m => 'SerialT' m Event

1488+-- acidRain = 'asyncly' $ 'constRate' 1 $ S.'repeatM' $ liftIO $ return $ Harm 1

1481--

1489--

1482−-- acidRain :: MonadAsync m => SerialT m Event

1490+-- data Result = Check | Done

1483−-- acidRain = asyncly $ constRate 1 $ S.repeatM $ liftIO $ return $ Harm 1

1484--

1491--

1485−-- game :: ('MonadAsync' m, MonadState Int m) => 'SerialT' m ()

1492+-- runEvents :: (MonadAsync m, MonadState Int m) => 'SerialT' m Result

1486−-- game = do

1493+-- runEvents = do

1487-- event \<- userAction \`parallel` acidRain

1494-- event \<- userAction \`parallel` acidRain

1488-- case event of

1495-- case event of

1489−-- Harm n -> modify $ \\h -> h - n

1496+-- Harm n -> modify (\\h -> h - n) >> return Check

1490−-- Heal n -> modify $ \\h -> h + n

1497+-- Heal n -> modify (\\h -> h + n) >> return Check

1491−-- Quit -> fail "quit"

1498+-- Quit -> return Done

1492−--

1499+--

1500+-- data Status = Alive | GameOver deriving Eq

1501+--

1502+-- getStatus :: (MonadAsync m, MonadState Int m) => Result -> m Status

1503+-- getStatus result =

1504+-- case result of

1505+-- Done -> liftIO $ putStrLn "You quit!" >> return GameOver

1506+-- Check -> do

1493−-- h <- get

1507+-- h <- get

1494−-- when (h <= 0) $ fail "You die!"

1508+-- liftIO $ if (h <= 0)

1509+-- then putStrLn "You die!" >> return GameOver

1495−-- liftIO $ putStrLn $ "Health = " ++ show h

1510+-- else putStrLn ("Health = " <> show h) >> return Alive

1496−--

1511+--

1512+-- main :: IO ()

1497-- main = do

1513-- main = do

1498-- putStrLn "Your health is deteriorating due to acid rain,\\

1514-- putStrLn "Your health is deteriorating due to acid rain,\\

1499-- \\ type \\"potion\\" or \\"quit\\""

1515-- \\ type \\"potion\\" or \\"quit\\""

1516+-- let runGame = S.'runWhile' (== Alive) $ S.'mapM' getStatus runEvents

1500−-- _ <- runStateT ('runStream' game) 60

1517+-- void $ runStateT runGame 60

1501−-- return ()

1502-- @

1518-- @

1503--

1519--

1504-- You can also find the source of this example in the examples directory as

1520-- You can also find the source of this example in the examples directory as

1505−-- "AcidRain.hs". It has been adapted from Gabriel's

1521+-- <src/examples/AcidRain.hs AcidRain.hs>. It has been adapted from Gabriel's

1506-- <https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html pipes-concurrency>

1522-- <https://hackage.haskell.org/package/pipes-concurrency-2.0.8/docs/Pipes-Concurrent-Tutorial.html pipes-concurrency>

1507-- package.

1523-- package.

1508-- This is much simpler compared to the pipes version because of the builtin

1524-- This is much simpler compared to the pipes version because of the builtin

1509-- concurrency in streamly. You can also find a SDL based reactive programming

1525-- concurrency in streamly. You can also find a SDL based reactive programming

1510−-- example adapted from Yampa in "Streamly.Examples.CirclingSquare".

1526+-- example adapted from Yampa in

1527+-- <src/examples/CirclingSquare.hs CirclingSquare.hs>.

1511

1528

1512-- $performance

1529-- $performance

1513--

1530--