git.iko.soy/streamly
on master help sign in
Add "afterFirst" run an action after first event
c60d15cHarendra Kumar
src/Asyncly.hs+2
compare with master
unifiedsplit
@@ -36,6 +36,8 @@ module Asyncly
36 , (*>>)
36 , (*>>)
37 , thenDiscard
37 , thenDiscard
38 , (>>*)
38 , (>>*)
39+ , afterFirst
40+ , (>>|)
39
41
40 , Log
42 , Log
41 , Loggable
43 , Loggable
src/Asyncly/AsyncT.hs+14−21
@@ -34,6 +34,8 @@ module Asyncly.AsyncT
34 , (*>>)
34 , (*>>)
35 , thenDiscard
35 , thenDiscard
36 , (>>*)
36 , (>>*)
37+ , afterFirst
38+ , (>>|)
37
39
38 -- internal
40 -- internal
39 , dbg
41 , dbg
@@ -603,31 +605,22 @@ instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
603-- Special compositions
605-- Special compositions
604------------------------------------------------------------------------------
606------------------------------------------------------------------------------
605
607
606−infixr 1 >>*, *>>
608+infixr 1 >>*, *>>, >>|
607
609
608−{-
610+-- XXX This can be moved to utility functions as it is purely app level
609-- | Run @b@ once, discarding its result when the first task in task set @a@
611-- | Run @b@ once, discarding its result when the first task in task set @a@
610-- has finished. Useful to start a singleton task after the first task has been
612-- has finished. Useful to start a singleton task after the first task has been
611-- setup.
613-- setup.
612−afterFirst :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
614+afterFirst :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
613−afterFirst ma mb = AsyncT $ do
615+afterFirst ma mb = do
614− fs <- getContinuations
615− ref <- liftIO $ newIORef False
616+ ref <- liftIO $ newIORef False
616− setContinuation ma (cont ref) fs
617+ x <- ma
617− r <- runAsyncT ma
618− restoreStack fs
619− return r
620− where cont ref x = AsyncT $ do
621− n <- liftIO $ readIORef ref
618+ done <- liftIO $ readIORef ref
622− if n == True
623− then return $ Just x
624− else do liftIO $ writeIORef ref True
619+ when (not done) $ (liftIO $ writeIORef ref True) >>* mb
625− runAsyncT mb
626− return $ Just x
620+ return x
627−
621+
628−(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
622+(>>|) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
629−(<|) = afterFirst
623+(>>|) = afterFirst
630− -}
631
624
632-- | Run 'm a' in "isolation" and discard its result, and then run 'm b' and
625-- | Run 'm a' in "isolation" and discard its result, and then run 'm b' and
633-- return its result. Isolation means that any alternative actions inside 'm
626-- return its result. Isolation means that any alternative actions inside 'm
test/Main.hs+10
@@ -101,6 +101,16 @@ main = hspec $ do
101 )
101 )
102 `shouldReturn` ([2] :: [Int])
102 `shouldReturn` ([2] :: [Int])
103
103
104+ -- 2 and 3 should be printed once and only once
105+ it ">>| works as expected" $
106+ ((wait $ ((async (liftIO (putStrLn "0") >> return 0)
107+ <|> (liftIO (putStrLn "1") >> return 1))
108+ >>| (async (liftIO (putStrLn "2") >> return 2)
109+ <|> (liftIO (putStrLn "3") >> return 3))
110+ )
111+ ) >>= return . sort)
112+ `shouldReturn` ([0, 1] :: [Int])
113+
104generalExample :: AsyncT IO Int
114generalExample :: AsyncT IO Int
105generalExample = do
115generalExample = do
106 liftIO $ return ()
116 liftIO $ return ()