on master help sign in
Add interleaved composition
commit5f1dc97a9a40209f42500a23d1ef022435b83496 authorHarendra Kumar <harendra.kumar@gmail.com> dateTue 29 Aug 2017, 07:55 (9 years ago) parent57e6232
4 files changed+29
examples/loop.hs+9 src/Asyncly.hs+2 src/Asyncly/AsyncT.hs+15 test/Main.hs+3
examples/loop.hs+9
@@ -9,22 +9,31 @@ import Asyncly
99main = do
1010 liftIO $ hSetBuffering stdout LineBuffering
1111
12+ putStrLn $ "\nloopTail:\n"
1213 runAsyncly $ do
1314 x <- loopTail (0 :: Int)
1415 liftIO $ print x
1516
17+ putStrLn $ "\nloopHead:\n"
1618 runAsyncly $ do
1719 x <- loopHead (0 :: Int)
1820 liftIO $ print x
1921
22+ putStrLn $ "\nloopTailA:\n"
2023 runAsyncly $ do
2124 x <- loopTailA (0 :: Int)
2225 liftIO $ print x
2326
27+ putStrLn $ "\nloopHeadA:\n"
2428 runAsyncly $ do
2529 x <- loopHeadA (0 :: Int)
2630 liftIO $ print x
2731
32+ putStrLn $ "\ninterleave:\n"
33+ runAsyncly $ do
34+ x <- return (0 :: Int) <> return 1 <=> return 100 <> return 101
35+ liftIO $ print x
36+
2837 where
2938
3039-------------------------------------------------------------------------------
src/Asyncly.hs+2
@@ -128,6 +128,8 @@ module Asyncly
128128 , toList
129129 , each
130130 , for
131+ , interleave
132+ , (<=>)
131133 )
132134where
133135
src/Asyncly/AsyncT.hs+15
@@ -23,6 +23,8 @@ module Asyncly.AsyncT
2323 , toList
2424 , each
2525 , for
26+ , interleave
27+ , (<=>)
2628-- , async
2729-- , makeAsync
2830 )
@@ -122,6 +124,19 @@ instance Monad m => Monoid (AsyncT m a) where
122124 yield a c (Just r) = yld a c (Just (mappend r m2))
123125 in m1 ctx stop yield
124126
127+-- | interleaves the results of two AsyncT computations
128+interleave :: AsyncT m a -> AsyncT m a -> AsyncT m a
129+interleave m1 m2 = AsyncT $ \ctx stp yld -> do
130+ let stop = (runAsyncT m2) ctx stp yld
131+ yield a c Nothing = yld a c (Just m2)
132+ yield a c (Just r) = yld a c (Just (interleave m2 r))
133+ (runAsyncT m1) ctx stop yield
134+
135+infixr 5 <=>
136+
137+(<=>) :: AsyncT m a -> AsyncT m a -> AsyncT m a
138+(<=>) = interleave
139+
125140-- We do not use bind for parallelism. That is, we do not start each iteration
126141-- of the list in parallel. That will introduce too much uncontrolled
127142-- parallelism. Instead we control parallelism using <|>, it is used for
test/Main.hs+3
@@ -22,6 +22,9 @@ main = hspec $ do
2222 toList (return 0 <> return 1) `shouldReturn` ([0, 1] :: [Int])
2323 it "Monoid composition - each" $
2424 ((toList $ each [1..100]) >>= return . sort) `shouldReturn` ([1..100] :: [Int])
25+ it "Interleaved composition" $
26+ toList (return (0 :: Int) <> return 1 <=> return 100 <> return 101)
27+ `shouldReturn` ([0, 100, 1, 101])
2528 it "simple runAsyncly and 'then' with IO" $
2629 runAsyncly (liftIO (putStrLn "hello") >> liftIO (putStrLn "world")) `shouldReturn` ()
2730 it "Then and toList" $