@@ -34,6 +34,8 @@ module Asyncly.AsyncT
3434 , (*>>)
3535 , thenDiscard
3636 , (>>*)
37+ , afterFirst
38+ , (>>|)
3739
3840 -- internal
3941 , dbg
@@ -603,31 +605,22 @@ instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
603605-- Special compositions
604606------------------------------------------------------------------------------
605607
606−infixr 1 >>*, *>>
608+infixr 1 >>*, *>>, >>|
607609
608−{-
610+-- XXX This can be moved to utility functions as it is purely app level
609611-- | Run @b@ once, discarding its result when the first task in task set @a@
610612-- has finished. Useful to start a singleton task after the first task has been
611613-- setup.
612−afterFirst :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
613−afterFirst ma mb = AsyncT $ do
614− fs <- getContinuations
615− ref <- liftIO $ newIORef False
616− setContinuation ma (cont ref) fs
617− r <- runAsyncT ma
618− restoreStack fs
619− return r
620− where cont ref x = AsyncT $ do
621− n <- liftIO $ readIORef ref
622− if n == True
623− then return $ Just x
624− else do liftIO $ writeIORef ref True
625− runAsyncT mb
626− return $ Just x
627−
628−(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
629−(<|) = afterFirst
630− -}
614+afterFirst :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
615+afterFirst ma mb = do
616+ ref <- liftIO $ newIORef False
617+ x <- ma
618+ done <- liftIO $ readIORef ref
619+ when (not done) $ (liftIO $ writeIORef ref True) >>* mb
620+ return x
621+
622+(>>|) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
623+(>>|) = afterFirst
631624
632625-- | Run 'm a' in "isolation" and discard its result, and then run 'm b' and
633626-- return its result. Isolation means that any alternative actions inside 'm