module Control.Concurrent.Async.Lifted.Safe
(
#if MIN_VERSION_monad_control(1, 0, 0)
A.Async
, async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask
, withAsync, withAsyncBound, withAsyncOn
, withAsyncWithUnmask, withAsyncOnWithUnmask
, wait, poll, waitCatch
, cancel, cancelWith
, A.asyncThreadId
, A.waitSTM, A.pollSTM, A.waitCatchSTM
, waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel
, waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel
, Unsafe.waitEither_
, waitBoth
, Unsafe.link, Unsafe.link2
, race, race_, concurrently, mapConcurrently
, Concurrently(..), Pure
#endif
) where
#if MIN_VERSION_monad_control(1, 0, 0)
import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Monad
import Control.Concurrent.Async (Async)
import Control.Exception.Lifted (SomeException, Exception)
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Trans.Control hiding (restoreM)
import Data.Constraint ((\\), (:-))
import Data.Constraint.Forall (Forall, inst)
import qualified Control.Concurrent.Async as A
import qualified Control.Concurrent.Async.Lifted as Unsafe
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 710
import Data.Traversable
#endif
async :: (MonadBaseControl IO m, StM m a ~ a) => m a -> m (Async a)
async = Unsafe.async
asyncBound :: (MonadBaseControl IO m, StM m a ~ a) => m a -> m (Async a)
asyncBound = Unsafe.asyncBound
asyncOn :: (MonadBaseControl IO m, StM m a ~ a) => Int -> m a -> m (Async a)
asyncOn = Unsafe.asyncOn
asyncWithUnmask
:: (MonadBaseControl IO m, StM m a ~ a)
=> ((forall b. m b -> m b) -> m a)
-> m (Async a)
asyncWithUnmask = Unsafe.asyncWithUnmask
asyncOnWithUnmask
:: (MonadBaseControl IO m, StM m a ~ a)
=> Int
-> ((forall b. m b -> m b) -> m a)
-> m (Async a)
asyncOnWithUnmask = Unsafe.asyncOnWithUnmask
withAsync
:: (MonadBaseControl IO m, StM m a ~ a)
=> m a
-> (Async a -> m b)
-> m b
withAsync = Unsafe.withAsync
withAsyncBound
:: (MonadBaseControl IO m, StM m a ~ a)
=> m a
-> (Async a -> m b)
-> m b
withAsyncBound = Unsafe.withAsyncBound
withAsyncOn
:: (MonadBaseControl IO m, StM m a ~ a)
=> Int
-> m a
-> (Async a -> m b)
-> m b
withAsyncOn = Unsafe.withAsyncOn
withAsyncWithUnmask
:: (MonadBaseControl IO m, StM m a ~ a)
=> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncWithUnmask = Unsafe.withAsyncWithUnmask
withAsyncOnWithUnmask
:: (MonadBaseControl IO m, StM m a ~ a)
=> Int
-> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncOnWithUnmask = Unsafe.withAsyncOnWithUnmask
wait :: (MonadBaseControl IO m, StM m a ~ a) => Async a -> m a
wait = Unsafe.wait
poll
:: (MonadBaseControl IO m, StM m a ~ a)
=> Async a
-> m (Maybe (Either SomeException a))
poll = Unsafe.poll
waitCatch
:: (MonadBaseControl IO m, StM m a ~ a)
=> Async a
-> m (Either SomeException a)
waitCatch = Unsafe.waitCatch
cancel :: MonadBase IO m => Async a -> m ()
cancel = Unsafe.cancel
cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()
cancelWith = Unsafe.cancelWith
waitAny
:: (MonadBaseControl IO m, StM m a ~ a)
=> [Async a] -> m (Async a, a)
waitAny = Unsafe.waitAny
waitAnyCatch
:: (MonadBaseControl IO m, StM m a ~ a)
=> [Async a]
-> m (Async a, Either SomeException a)
waitAnyCatch = Unsafe.waitAnyCatch
waitAnyCancel
:: (MonadBaseControl IO m, StM m a ~ a)
=> [Async a]
-> m (Async a, a)
waitAnyCancel = Unsafe.waitAnyCancel
waitAnyCatchCancel
:: (MonadBaseControl IO m, StM m a ~ a)
=> [Async a]
-> m (Async a, Either SomeException a)
waitAnyCatchCancel = Unsafe.waitAnyCatchCancel
waitEither
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> Async a
-> Async b
-> m (Either a b)
waitEither = Unsafe.waitEither
waitEitherCatch
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch = Unsafe.waitEitherCatch
waitEitherCancel
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> Async a
-> Async b
-> m (Either a b)
waitEitherCancel = Unsafe.waitEitherCancel
waitEitherCatchCancel
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel = Unsafe.waitEitherCatchCancel
waitBoth
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> Async a
-> Async b
-> m (a, b)
waitBoth = Unsafe.waitBoth
race
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> m a -> m b -> m (Either a b)
race = Unsafe.race
race_
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> m a -> m b -> m ()
race_ = Unsafe.race_
concurrently
:: (MonadBaseControl IO m, StM m a ~ a, StM m b ~ b)
=> m a -> m b -> m (a, b)
concurrently = Unsafe.concurrently
mapConcurrently
:: (Traversable t, MonadBaseControl IO m, Forall (Pure m))
=> (a -> m b)
-> t a
-> m (t b)
mapConcurrently f = runConcurrently . traverse (Concurrently . f)
data Concurrently m a where
Concurrently
:: Forall (Pure m) => { runConcurrently :: m a } -> Concurrently m a
class StM m a ~ a => Pure m a
instance StM m a ~ a => Pure m a
instance Functor m => Functor (Concurrently m) where
fmap f (Concurrently a) = Concurrently $ f <$> a
instance (MonadBaseControl IO m, Forall (Pure m)) =>
Applicative (Concurrently m) where
pure = Concurrently . pure
Concurrently (fs :: m (a -> b)) <*> Concurrently as =
Concurrently (uncurry ($) <$> concurrently fs as)
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m (a -> b))
instance (MonadBaseControl IO m, Forall (Pure m)) =>
Alternative (Concurrently m) where
empty = Concurrently . liftBaseWith . const $ forever (threadDelay maxBound)
Concurrently (as :: m a) <|> Concurrently bs =
Concurrently (either id id <$> race as bs)
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
instance (MonadBaseControl IO m, Forall (Pure m)) =>
Monad (Concurrently m) where
return = Concurrently . return
Concurrently a >>= f = Concurrently $ a >>= runConcurrently . f
#endif