@@ -29,8 +29,11 @@ module Asyncly.AsyncT
30 , makeAsync
30 , makeAsync
33− , (**>)
35+ , thenDiscard
35 -- internal
38 -- internal
@@ -488,13 +491,13 @@ each xs = foldl (<|>) empty $ map return xs
488-- | Runs a computation under a given thread limit. A limit of 0 means new
491-- | Runs a computation under a given thread limit. A limit of 0 means new
489-- tasks start synchronously in the current thread. New threads are created by
492-- tasks start synchronously in the current thread. New threads are created by
490-- 'parallel', and APIs that use parallel.
493-- '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
492threads n process = AsyncT $ do
495threads n process = AsyncT $ do
493 oldCr <- gets threadCredit
496 oldCr <- gets threadCredit
494 newCr <- liftIO $ newIORef n
497 newCr <- liftIO $ newIORef n
495 modify $ \s -> s { threadCredit = newCr }
498 modify $ \s -> s { threadCredit = newCr }
496 r <- runAsyncT $ process
499 r <- runAsyncT $ process
497− <** (AsyncT $ do
500+ >>* (AsyncT $ do
498 modify $ \s -> s { threadCredit = oldCr }
501 modify $ \s -> s { threadCredit = oldCr }
499 return (Just ())
502 return (Just ())
500 ) -- restore old credit
503 ) -- restore old credit
@@ -588,10 +591,6 @@ instance (MonadBaseControl b m, MonadAsync m) => MonadBaseControl b (AsyncT m) w
588instance MonadAsync m => MonadThrow (AsyncT m) where
591instance MonadAsync m => MonadThrow (AsyncT m) where
589 throwM e = lift $ throwM e
592 throwM e = lift $ throwM e
591−------------------------------------------------------------------------------
592−-- More operators, instances
593−------------------------------------------------------------------------------
595instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
594instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
596 fromInteger = return . fromInteger
595 fromInteger = return . fromInteger
597 mf + mg = (+) <$> mf <*> mg
596 mf + mg = (+) <$> mf <*> mg
@@ -600,47 +599,18 @@ instance (Num a, Monad (AsyncT m)) => Num (AsyncT m a) where
600 abs f = f >>= return . abs
599 abs f = f >>= return . abs
601 signum f = f >>= return . signum
600 signum f = f >>= return . signum
603−{-
602+------------------------------------------------------------------------------
604−-- | Warning: Radically untyped stuff. handle with care
603+-- Special compositions
605−getContinuations :: Monad m => StateM m [a -> AsyncT m b]
604+------------------------------------------------------------------------------
606−getContinuations = do
607− EventF { fcomp = fs } <- get
608− return $ unsafeCoerce fs
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
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), .. }
627− (<***) :: AsyncT m a -> AsyncT m b -> AsyncT m a
630− fs <- getContinuations
631− setContinuation ma (\x -> mb >> return x) fs
637−infixr 1 <***, <**, **>
606+infixr 1 >>*, *>>
639-- | Run @b@ once, discarding its result when the first task in task set @a@
609-- | Run @b@ once, discarding its result when the first task in task set @a@
640-- has finished. Useful to start a singleton task after the first task has been
610-- has finished. Useful to start a singleton task after the first task has been
642−(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
612+afterFirst :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
643−(<|) ma mb = AsyncT $ do
613+afterFirst ma mb = AsyncT $ do
644 fs <- getContinuations
614 fs <- getContinuations
645 ref <- liftIO $ newIORef False
615 ref <- liftIO $ newIORef False
646 setContinuation ma (cont ref) fs
616 setContinuation ma (cont ref) fs
@@ -655,19 +625,31 @@ infixr 1 <***, <**, **>
655 runAsyncT mb
625 runAsyncT mb
656 return $ Just x
626 return $ Just x
628+(<|) :: MonadIO m => AsyncT m a -> AsyncT m b -> AsyncT m a
660−infixr 1 <**, **>
632+-- | Run 'm a' in "isolation" and discard its result, and then run 'm b' and
661−
633+-- return its result. Isolation means that any alternative actions inside 'm
662−-- | Run @m a@ discarding its result before running @m b@.
634+-- a' are not continued to 'm b'.
663−(**>) :: Monad m => AsyncT m a -> AsyncT m b -> AsyncT m b
635+discardAndThen :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
664−(**>) x y = AsyncT $ do
636+discardAndThen ma mb = AsyncT $ do
665− _ <- runAsyncT x
637+ _ <- runAsyncT (ma >> mzero)
666− runAsyncT y
638+ runAsyncT mb
668−-- | Run @m b@ discarding its result, after the whole task set @m a@ is done.
640+-- | Same as 'discardAndThen'.
669−(<**) :: Monad m => AsyncT m a -> AsyncT m b -> AsyncT m a
641+(*>>) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m b
670−(<**) ma mb = AsyncT $ do
642+(*>>) = discardAndThen
671− a <- runAsyncT ma
643+
672− _ <- runAsyncT mb
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
650+ _ <- runAsyncT (mb >> mzero)
673− return a
651+ return a
653+-- | Same as 'thenDiscard'.
654+(>>*) :: MonadAsync m => AsyncT m a -> AsyncT m b -> AsyncT m a