7e3465d · streamly · git.iko.soy

asyncly.cabal+17−60

compare with master

unifiedsplit

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

75 , Asyncly.Prelude

76 , Asyncly.Time

77 , 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

78

84

79 default-language: Haskell2010

85 default-language: Haskell2010

80 ghc-options: -Wall

86 ghc-options: -Wall

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

104 , stm >= 2.4.3 && < 2.5

110 , stm >= 2.4.3 && < 2.5

105 , transformers >= 0.4 && < 0.6

111 , transformers >= 0.4 && < 0.6

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

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

113+

107 if impl(ghc < 8.0)

114 if impl(ghc < 8.0)

108 build-depends:

115 build-depends:

109 semigroups >= 0.18 && < 0.19

116 semigroups >= 0.18 && < 0.19

110

117

118+ if flag(examples)

119+ build-Depends:

120+ http-conduit

121+ , path-io

122+ , random

123+ , SDL >= 0.6.5 && < 0.7

124+

111test-suite test

125test-suite test

112 type: exitcode-stdio-1.0

126 type: exitcode-stdio-1.0

113 main-is: Main.hs

127 main-is: Main.hs

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

174 , transient >= 0.4 && < 0.6

188 , transient >= 0.4 && < 0.6

175 default-language: Haskell2010

189 default-language: Haskell2010

176

190

177−executable circle-mouse

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

178− main-is: circle-mouse.hs

192+-- Examples

179− hs-source-dirs: examples

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

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

188

194

189executable echo-loop

195executable echo-loop

190 main-is: echo-loop.hs

196 main-is: echo-loop.hs

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

197 else

203 else

198 buildable: False

204 buildable: False

199

205

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−

237executable loops

206executable loops

238 main-is: loops.hs

207 main-is: loops.hs

239 hs-source-dirs: examples

208 hs-source-dirs: examples

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

256 else

225 else

257 buildable: False

226 buildable: False

258

227

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−

271executable nested-loops

228executable nested-loops

272 main-is: nested-loops.hs

229 main-is: nested-loops.hs

273 hs-source-dirs: examples

230 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 @@

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

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

5

6+module Asyncly.Examples.AcidRainGame where

7+

6import Asyncly

8import Asyncly

7import Control.Concurrent (threadDelay)

9import Control.Concurrent (threadDelay)

8import Control.Monad (when)

10import Control.Monad (when)

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

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

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

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

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

38

40

39−main = do

41+acidRainGame :: IO ()

42+acidRainGame = do

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

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

41 \ type \"potion\" or \"quit\""

44 \ 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 @@

5-- compile it like this:

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

7

8+module Asyncly.Examples.CirclingSquare where

9+

8import Data.IORef

10import Data.IORef

9import Graphics.UI.SDL as SDL

11import Graphics.UI.SDL as SDL

10import Asyncly

12import Asyncly

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

20

22

21 let width = 640

23 let width = 640

22 height = 480

24 height = 480

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

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

24 SDL.setCaption "Test" ""

26 SDL.setCaption "Test" ""

25

27

26------------------------------------------------------------------------------

28------------------------------------------------------------------------------

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

34 -- Paint screen green

36 -- Paint screen green

35 let format = surfaceGetPixelFormat screen

37 let format = surfaceGetPixelFormat screen

36 bgColor <- mapRGB format 55 60 64

38 bgColor <- mapRGB format 55 60 64

37− fillRect screen Nothing bgColor

39+ _ <- fillRect screen Nothing bgColor

38

40

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

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

40 foreC <- mapRGB format 212 108 73

42 foreC <- mapRGB format 212 108 73

41 let side = 10

43 let side = 10

42 x = round playerX

44 x = round playerX

43 y = round playerY

45 y = round playerY

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

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

45

47

46 -- Double buffering

48 -- Double buffering

47 SDL.flip screen

49 SDL.flip screen

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

50-- Wait and update Controller Position if it changes

52-- Wait and update Controller Position if it changes

51------------------------------------------------------------------------------

53------------------------------------------------------------------------------

52

54

55+refreshRate :: Int

53refreshRate = 40

56refreshRate = 40

54

57

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

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

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

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

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

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

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

82

85

83−main = do

86+circlingSquare :: IO ()

87+circlingSquare = do

84 sdlInit

88 sdlInit

85 cref <- newIORef (0,0)

89 cref <- newIORef (0,0)

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

90 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

3{-# LANGUAGE FlexibleContexts #-}

1{-# LANGUAGE FlexibleContexts #-}

4

2

3+module Asyncly.Examples.ListDirRecursive where

4+

5import Path.IO (listDir, getCurrentDir)

6−import Path (Path, Dir, reldir)

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

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

8import Asyncly

7import Asyncly

9

8

10−main = do

9+listDirRecursive :: IO ()

10+listDirRecursive = do

11 liftIO $ hSetBuffering stdout LineBuffering

12 runAsyncly $ getCurrentDir >>= readdir

13 where readdir d = do

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

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

1+{-# LANGUAGE FlexibleContexts #-}

2+

3+module Asyncly.Examples.MergeSortedStreams where

4+

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

1+module Asyncly.Examples.SearchEngineQuery where

2−-- stack runghc

3

2

4import Asyncly

3import Asyncly

5import Asyncly.Prelude (ZipAsync (..))

4import Asyncly.Prelude (ZipAsync (..))

6import Network.HTTP.Simple

5import Network.HTTP.Simple

7

6

8-- Runs three search engine queries in parallel.

7-- Runs three search engine queries in parallel.

9−main = do

8+searchEngineQuery :: IO ()

9+searchEngineQuery = do

10 putStrLn "Using parallel alternative"

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

12

stack.yaml+2−2

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

10extra-package-dbs: []

11rebuild-ghc-options: true

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

13−#extra-include-dirs:

13+extra-include-dirs:

14−#- /opt/local/include

14+- /opt/local/include