@@ -29,8 +29,11 @@ module Asyncly.AsyncT
2929 , async
3030 , makeAsync
3131 , each
32− , (<**)
33− , (**>)
32+
33+ , discardAndThen
34+ , (*>>)
35+ , thenDiscard
36+ , (>>*)
3437
3538 -- internal
3639 , dbg
@@ -488,13 +491,13 @@ each xs = foldl (<|>) empty $ map return xs
488491-- | Runs a computation under a given thread limit. A limit of 0 means new
489492-- tasks start synchronously in the current thread. New threads are created by
490493-- 'parallel', and APIs that use parallel.
491−threads :: MonadIO m => Int -> AsyncT m a -> AsyncT m a
494+threads :: MonadAsync m => Int -> AsyncT m a -> AsyncT m a
492495threads n process = AsyncT $ do
493496 oldCr <- gets threadCredit
494497 newCr <- liftIO $ newIORef n
495498 modify $ \s -> s { threadCredit = newCr }
496499 r <- runAsyncT $ process
497− <** (AsyncT $ do
500+ >>* (AsyncT $ do
498501 modify $ \s -> s { threadCredit = oldCr }
499502 return (Just ())
500503 ) -- restore old credit
@@ -588,10 +591,6 @@ instance (MonadBaseControl b m, MonadAsync m) => MonadBaseControl b (AsyncT m) w
588591instance MonadAsync m => MonadThrow (AsyncT m) where
589592 throwM e = lift $ throwM e
590593
591−------------------------------------------------------------------------------
592−-- More operators, instances
593−------------------------------------------------------------------------------
594−
595594instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
596595 fromInteger = return . fromInteger
597596 mf + mg = (+) <$> mf <*> mg
@@ -600,47 +599,18 @@ instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
600599 abs f = f >>= return . abs
601600 signum f = f >>= return . signum
602601
603−{-
604−-- | Warning: Radically untyped stuff. handle with care
605−getContinuations :: Monad m => StateM m [a -> AsyncT m b]
606−getContinuations = do
607− EventF { fcomp = fs } <- get
608− return $ unsafeCoerce fs
609−
610−-- | Save a closure and a continuation ('x' and 'f' in 'x >>= f').
611−setContinuation :: Monad m
612− => AsyncT m a -> (a -> AsyncT m b) -> [c -> AsyncT m c] -> StateM m ()
613−setContinuation b c fs = do
614− modify $ \EventF{..} -> EventF { xcomp = b
615− , fcomp = unsafeCoerce c : fs
616− , .. }
617−
618−-- | Restore the continuations to the provided ones.
619−-- | NOTE: Events are also cleared out.
620−restoreStack :: MonadState EventF m => t -> m ()
621−restoreStack fs = modify $ \EventF {..} ->
622− EventF { event = Nothing, fcomp = (unsafeCoerce fs), .. }
623−
624−-}
602+------------------------------------------------------------------------------
603+-- Special compositions
604+------------------------------------------------------------------------------
625605
626−{-
627− (<***) :: AsyncT m a -> AsyncT m b -> AsyncT m a
628− (<***) ma mb =
629− AsyncT $ do
630− fs <- getContinuations
631− setContinuation ma (\x -> mb >> return x) fs
632− a <- runAsyncT ma
633− runAsyncT mb
634− restoreStack fs
635− return a
636−
637−infixr 1 <***, <**, **>
606+infixr 1 >>*, *>>
638607
608+{-
639609-- | Run @b@ once, discarding its result when the first task in task set @a@
640610-- has finished. Useful to start a singleton task after the first task has been
641611-- setup.
642−(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
643−(<|) ma mb = AsyncT $ do
612+afterFirst :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
613+afterFirst ma mb = AsyncT $ do
644614 fs <- getContinuations
645615 ref <- liftIO $ newIORef False
646616 setContinuation ma (cont ref) fs
@@ -655,19 +625,31 @@ infixr 1 <***, <**, **>
655625 runAsyncT mb
656626 return $ Just x
657627
658−-}
659−
660−infixr 1 <**, **>
661−
662−-- | Run @m a@ discarding its result before running @m b@.
663−(**>) :: Monad m => AsyncT m a -> AsyncT m b -> AsyncT m b
664−(**>) x y = AsyncT $ do
665− _ <- runAsyncT x
666− runAsyncT y
667−
668−-- | Run @m b@ discarding its result, after the whole task set @m a@ is done.
669−(<**) :: Monad m => AsyncT m a -> AsyncT m b -> AsyncT m a
670−(<**) ma mb = AsyncT $ do
671− a <- runAsyncT ma
672− _ <- runAsyncT mb
673− return a
628+(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
629+(<|) = afterFirst
630+ -}
631+
632+-- | 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
634+-- a' are not continued to 'm b'.
635+discardAndThen :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
636+discardAndThen ma mb = AsyncT $ do
637+ _ <- runAsyncT (ma >> mzero)
638+ runAsyncT mb
639+
640+-- | Same as 'discardAndThen'.
641+(*>>) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
642+(*>>) = discardAndThen
643+
644+-- | Run 'm a' and then run 'm b' in "isolation" and return the result of 'm
645+-- a'. Isolation means that any alternative actions inside 'm a' are not
646+-- continued to 'm b' and the results of 'm b' are discarded.
647+thenDiscard :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
648+thenDiscard ma mb = AsyncT $ do
649+ a <- runAsyncT ma
650+ _ <- runAsyncT (mb >> mzero)
651+ return a
652+
653+-- | Same as 'thenDiscard'.
654+(>>*) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a
655+(>>*) = thenDiscard