7e3465d · streamly · git.iko.soy

git.iko.soy/streamly

Move examples to Asyncly.Examples module

commit7e3465d35b93ce77d7c76ccf1d88f02159886175 authorHarendra Kumar <harendra.kumar@gmail.com> dateSat 21 Oct 2017, 01:49 (9 years ago) parentabd2c91

8 files changed+80−114

compare with master

unifiedsplit

asyncly.cabal+17−60 examples/mergesort.hs−39 examples/game.hs → src/Asyncly/Examples/AcidRainGame.hs+6−2 examples/circle-mouse.hs → src/Asyncly/Examples/CirclingSquare.hs+8−4 examples/listdir.hs → src/Asyncly/Examples/ListDirRecursive.hs+4−4 src/Asyncly/Examples/MergeSortedStreams.hs+40 examples/fastest.hs → src/Asyncly/Examples/SearchEngineQuery.hs+3−3 stack.yaml+2−2

asyncly.cabal+17−60

@@ -75,6 +75,12 @@ library

7575 , Asyncly.Prelude

7676 , Asyncly.Time

7777 , Asyncly.Tutorial

78+ if flag(examples)

79+ exposed-modules: Asyncly.Examples.SearchEngineQuery

80+ , Asyncly.Examples.ListDirRecursive

81+ , Asyncly.Examples.MergeSortedStreams

82+ , Asyncly.Examples.AcidRainGame

83+ , Asyncly.Examples.CirclingSquare

7884

7985 default-language: Haskell2010

8086 ghc-options: -Wall

@@ -104,10 +110,18 @@ library

104110 , stm >= 2.4.3 && < 2.5

105111 , transformers >= 0.4 && < 0.6

106112 , transformers-base >= 0.4 && < 0.5

113+

107114 if impl(ghc < 8.0)

108115 build-depends:

109116 semigroups >= 0.18 && < 0.19

110117

118+ if flag(examples)

119+ build-Depends:

120+ http-conduit

121+ , path-io

122+ , random

123+ , SDL >= 0.6.5 && < 0.7

124+

111125test-suite test

112126 type: exitcode-stdio-1.0

113127 main-is: Main.hs

@@ -174,17 +188,9 @@ benchmark bench

174188 , transient >= 0.4 && < 0.6

175189 default-language: Haskell2010

176190

177−executable circle-mouse

178− main-is: circle-mouse.hs

179− hs-source-dirs: examples

180− if flag(examples)

181− buildable: True

182− build-Depends:

183− asyncly

184− , base >= 4.8 && < 5

185− , SDL >= 0.6.5 && < 0.7

186− else

187− buildable: False

191+-------------------------------------------------------------------------------

192+-- Examples

193+-------------------------------------------------------------------------------

188194

189195executable echo-loop

190196 main-is: echo-loop.hs

@@ -197,43 +203,6 @@ executable echo-loop

197203 else

198204 buildable: False

199205

200−executable fastest

201− main-is: fastest.hs

202− hs-source-dirs: examples

203− if flag(examples)

204− buildable: True

205− build-Depends:

206− asyncly

207− , base >= 4.8 && < 5

208− , http-conduit

209− else

210− buildable: False

211−

212−executable game

213− main-is: game.hs

214− hs-source-dirs: examples

215− if flag(examples)

216− buildable: True

217− build-Depends:

218− asyncly

219− , base >= 4.8 && < 5

220− , mtl >= 2.2 && < 3

221− else

222− buildable: False

223−

224−executable listdir

225− main-is: listdir.hs

226− hs-source-dirs: examples

227− if flag(examples)

228− buildable: True

229− build-Depends:

230− asyncly

231− , base >= 4.8 && < 5

232− , path

233− , path-io

234− else

235− buildable: False

236−

237206executable loops

238207 main-is: loops.hs

239208 hs-source-dirs: examples

@@ -256,18 +225,6 @@ executable map-reduce

256225 else

257226 buildable: False

258227

259−executable mergesort

260− main-is: mergesort.hs

261− hs-source-dirs: examples

262− if flag(examples)

263− buildable: True

264− build-Depends:

265− asyncly

266− , base >= 4.8 && < 5

267− , random

268− else

269− buildable: False

270−

271228executable nested-loops

272229 main-is: nested-loops.hs

273230 hs-source-dirs: examples

examples/mergesort.hsdeleted−39

@@ -1,39 +0,0 @@

1−#!/usr/bin/env stack

2−-- stack runghc

3−

4−{-# LANGUAGE FlexibleContexts #-}

5−

6−import Data.Word

7−import System.Random

8−import Data.List (sort)

9−import Asyncly

10−import qualified Asyncly.Prelude as A

11−

12−getSorted = do

13− g <- liftIO getStdGen

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

15− foldMapWith (<>) return (sort ls)

16−

17−mergeAsync :: (Ord a, MonadAsync m)

18− => AsyncT m a -> AsyncT m a -> AsyncT m a

19−mergeAsync a b = do

20− x <- lift $ async a

21− y <- lift $ async b

22− merge x y

23−

24−merge a b = do

25− x <- lift $ A.uncons a

26− case x of

27− Nothing -> b

28− Just (va, ma) -> do

29− y <- lift $ A.uncons b

30− case y of

31− Nothing -> return va <> ma

32− Just (vb, mb) ->

33− if (vb < va)

34− then (return vb) <> merge (return va <> ma) mb

35− else (return va) <> merge ma (return vb <> mb)

36−

37−main = do

38− xs <- toList $ mergeAsync getSorted getSorted

39− putStrLn $ show $ length xs

examples/game.hs → src/Asyncly/Examples/AcidRainGame.hsrenamed+6−2

@@ -3,6 +3,8 @@

33-- This example is adapted from Gabriel Gonzalez's pipes-concurrency package.

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

6+module Asyncly.Examples.AcidRainGame where

68import Asyncly

79import Control.Concurrent (threadDelay)

810import Control.Monad (when)

@@ -36,7 +38,9 @@ game = do

3638 when (h <= 0) $ fail "You die!"

3739 liftIO $ putStrLn $ "Health = " ++ show h

3840

39−main = do

41+acidRainGame :: IO ()

42+acidRainGame = do

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

4144 \ type \"potion\" or \"quit\""

42− runStateT (runAsyncly game) 60

45+ _ <- runStateT (runAsyncly game) 60

46+ return ()

examples/circle-mouse.hs → src/Asyncly/Examples/CirclingSquare.hsrenamed+8−4

@@ -5,6 +5,8 @@

55-- compile it like this:

66-- stack ghc --package SDL circle-mouse.hs

8+module Asyncly.Examples.CirclingSquare where

810import Data.IORef

911import Graphics.UI.SDL as SDL

1012import Asyncly

@@ -20,7 +22,7 @@ sdlInit = do

2022

2123 let width = 640

2224 height = 480

23− screen <- SDL.setVideoMode width height 16 [SWSurface]

25+ _ <- SDL.setVideoMode width height 16 [SWSurface]

2426 SDL.setCaption "Test" ""

2527

2628------------------------------------------------------------------------------

@@ -34,14 +36,14 @@ display (playerX, playerY) = do

3436 -- Paint screen green

3537 let format = surfaceGetPixelFormat screen

3638 bgColor <- mapRGB format 55 60 64

37− fillRect screen Nothing bgColor

39+ _ <- fillRect screen Nothing bgColor

3840

3941 -- Paint small red square, at an angle 'angle' with respect to the center

4042 foreC <- mapRGB format 212 108 73

4143 let side = 10

4244 x = round playerX

4345 y = round playerY

44− fillRect screen (Just (Rect x y side side)) foreC

46+ _ <- fillRect screen (Just (Rect x y side side)) foreC

4547

4648 -- Double buffering

4749 SDL.flip screen

@@ -50,6 +52,7 @@ display (playerX, playerY) = do

5052-- Wait and update Controller Position if it changes

5153------------------------------------------------------------------------------

5254

55+refreshRate :: Int

5356refreshRate = 40

5457

5558updateController :: IORef (Double, Double) -> IO ()

@@ -80,7 +83,8 @@ updateDisplay cref = withClock clock refreshRate displaySquare

8083 let t = (fromIntegral time) * speed / 1000000

8184 in display (x + cos t * radius, y + sin t * radius)

8285

83−main = do

86+circlingSquare :: IO ()

87+circlingSquare = do

8488 sdlInit

8589 cref <- newIORef (0,0)

8690 runAsyncly $ liftIO (updateController cref) <|> liftIO (updateDisplay cref)

examples/listdir.hs → src/Asyncly/Examples/ListDirRecursive.hsrenamed+4−4

@@ -1,13 +1,13 @@

1−#!/usr/bin/env stack

2−-- stack runghc --package path --package path-io

31{-# LANGUAGE FlexibleContexts #-}

3+module Asyncly.Examples.ListDirRecursive where

55import Path.IO (listDir, getCurrentDir)

6−import Path (Path, Dir, reldir)

76import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))

87import Asyncly

10−main = do

9+listDirRecursive :: IO ()

10+listDirRecursive = do

1111 liftIO $ hSetBuffering stdout LineBuffering

1212 runAsyncly $ getCurrentDir >>= readdir

1313 where readdir d = do

src/Asyncly/Examples/MergeSortedStreams.hsnew file+40

@@ -0,0 +1,40 @@

1+{-# LANGUAGE FlexibleContexts #-}

3+module Asyncly.Examples.MergeSortedStreams where

5+import Data.Word

6+import System.Random

7+import Data.List (sort)

8+import Asyncly

9+import qualified Asyncly.Prelude as A

10+

11+getSorted :: MonadIO m => AsyncT m Word16

12+getSorted = do

13+ g <- liftIO getStdGen

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

15+ foldMapWith (<>) return (sort ls)

16+

17+mergeAsync :: (Ord a, MonadAsync m) => AsyncT m a -> AsyncT m a -> AsyncT m a

18+mergeAsync a b = do

19+ x <- lift $ async a

20+ y <- lift $ async b

21+ merge x y

22+

23+merge :: (Ord a, MonadAsync m) => AsyncT m a -> AsyncT m a -> AsyncT m a

24+merge a b = do

25+ a1 <- lift $ A.uncons a

26+ case a1 of

27+ Nothing -> b

28+ Just (x, ma) -> do

29+ b1 <- lift $ 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+

37+mergeSortedStreams :: IO ()

38+mergeSortedStreams = do

39+ xs <- toList $ mergeAsync getSorted getSorted

40+ putStrLn $ show $ length xs

examples/fastest.hs → src/Asyncly/Examples/SearchEngineQuery.hsrenamed+3−3

@@ -1,12 +1,12 @@

1−#!/usr/bin/env stack

2−-- stack runghc

1+module Asyncly.Examples.SearchEngineQuery where

43import Asyncly

54import Asyncly.Prelude (ZipAsync (..))

65import Network.HTTP.Simple

87-- Runs three search engine queries in parallel.

9−main = do

8+searchEngineQuery :: IO ()

9+searchEngineQuery = do

1010 putStrLn "Using parallel alternative"

1111 runAsyncly $ google <|> bing <|> duckduckgo

1212

stack.yaml+2−2

@@ -10,5 +10,5 @@ flags: {}

1010extra-package-dbs: []

1111rebuild-ghc-options: true

1212# For mac ports installed SDL library on Mac OS X

13−#extra-include-dirs:

14−#- /opt/local/include

13+extra-include-dirs:

14+- /opt/local/include