module Control.Concurrent.Async.Lifted.Safe
#if MIN_VERSION_monad_control(1, 0, 0)
(
A.Async
, Pure
, Forall
, 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
#if MIN_VERSION_async(2, 1, 0)
, A.waitAnySTM
, A.waitAnyCatchSTM
, A.waitEitherSTM
, A.waitEitherCatchSTM
, A.waitEitherSTM_
, A.waitBothSTM
#endif
, Unsafe.link, Unsafe.link2
, race, race_, concurrently, mapConcurrently
, Concurrently(..)
)
#else
#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
#if !MIN_VERSION_base(4, 8, 0)
import Data.Monoid (Monoid(mappend, mempty))
#elif MIN_VERSION_base(4, 9, 0)
import Data.Semigroup (Semigroup((<>)))
#endif
async
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> m a -> m (Async a)
async = Unsafe.async
\\ (inst :: Forall (Pure m) :- Pure m a)
asyncBound
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> m a -> m (Async a)
asyncBound = Unsafe.asyncBound
\\ (inst :: Forall (Pure m) :- Pure m a)
asyncOn
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> Int -> m a -> m (Async a)
asyncOn cpu m = Unsafe.asyncOn cpu m
\\ (inst :: Forall (Pure m) :- Pure m a)
asyncWithUnmask
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> ((forall b. m b -> m b) -> m a)
-> m (Async a)
asyncWithUnmask restore = Unsafe.asyncWithUnmask restore
\\ (inst :: Forall (Pure m) :- Pure m a)
asyncOnWithUnmask
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> Int
-> ((forall b. m b -> m b) -> m a)
-> m (Async a)
asyncOnWithUnmask cpu restore = Unsafe.asyncOnWithUnmask cpu restore
\\ (inst :: Forall (Pure m) :- Pure m a)
withAsync
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> m a
-> (Async a -> m b)
-> m b
withAsync = Unsafe.withAsync
\\ (inst :: Forall (Pure m) :- Pure m a)
withAsyncBound
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> m a
-> (Async a -> m b)
-> m b
withAsyncBound = Unsafe.withAsyncBound
\\ (inst :: Forall (Pure m) :- Pure m a)
withAsyncOn
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Int
-> m a
-> (Async a -> m b)
-> m b
withAsyncOn = Unsafe.withAsyncOn
\\ (inst :: Forall (Pure m) :- Pure m a)
withAsyncWithUnmask
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncWithUnmask restore = Unsafe.withAsyncWithUnmask restore
\\ (inst :: Forall (Pure m) :- Pure m a)
withAsyncOnWithUnmask
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Int
-> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncOnWithUnmask cpu restore = Unsafe.withAsyncOnWithUnmask cpu restore
\\ (inst :: Forall (Pure m) :- Pure m a)
wait
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> Async a -> m a
wait = Unsafe.wait
\\ (inst :: Forall (Pure m) :- Pure m a)
poll
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> m (Maybe (Either SomeException a))
poll = Unsafe.poll
\\ (inst :: Forall (Pure m) :- Pure m a)
waitCatch
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> m (Either SomeException a)
waitCatch = Unsafe.waitCatch
\\ (inst :: Forall (Pure m) :- Pure m a)
cancel :: MonadBase IO m => Async a -> m ()
cancel = Unsafe.cancel
cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()
cancelWith = Unsafe.cancelWith
waitAny
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> [Async a] -> m (Async a, a)
waitAny = Unsafe.waitAny
\\ (inst :: Forall (Pure m) :- Pure m a)
waitAnyCatch
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> [Async a]
-> m (Async a, Either SomeException a)
waitAnyCatch = Unsafe.waitAnyCatch
\\ (inst :: Forall (Pure m) :- Pure m a)
waitAnyCancel
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> [Async a]
-> m (Async a, a)
waitAnyCancel = Unsafe.waitAnyCancel
\\ (inst :: Forall (Pure m) :- Pure m a)
waitAnyCatchCancel
:: forall m a. (MonadBaseControl IO m, Forall (Pure m))
=> [Async a]
-> m (Async a, Either SomeException a)
waitAnyCatchCancel = Unsafe.waitAnyCatchCancel
\\ (inst :: Forall (Pure m) :- Pure m a)
waitEither
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> Async b
-> m (Either a b)
waitEither = Unsafe.waitEither
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
waitEitherCatch
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch = Unsafe.waitEitherCatch
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
waitEitherCancel
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> Async b
-> m (Either a b)
waitEitherCancel = Unsafe.waitEitherCancel
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
waitEitherCatchCancel
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel = Unsafe.waitEitherCatchCancel
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
waitBoth
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> Async a
-> Async b
-> m (a, b)
waitBoth = Unsafe.waitBoth
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
race
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> m a -> m b -> m (Either a b)
race = Unsafe.race
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
race_
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> m a -> m b -> m ()
race_ = Unsafe.race_
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
concurrently
:: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
=> m a -> m b -> m (a, b)
concurrently = Unsafe.concurrently
\\ (inst :: Forall (Pure m) :- Pure m a)
\\ (inst :: Forall (Pure m) :- Pure m b)
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)
#if MIN_VERSION_base(4, 9, 0)
instance (MonadBaseControl IO m, Semigroup a, Forall (Pure m)) =>
Semigroup (Concurrently m a) where
(<>) = liftA2 (<>)
instance (MonadBaseControl IO m, Semigroup a, Monoid a, Forall (Pure m)) =>
Monoid (Concurrently m a) where
mempty = pure mempty
mappend = (<>)
#else
instance (MonadBaseControl IO m, Monoid a, Forall (Pure m)) =>
Monoid (Concurrently m a) where
mempty = pure mempty
mappend = liftA2 mappend
#endif
#endif