{-# LANGUAGE CPP                    #-}
{-# LANGUAGE DataKinds              #-}
{-# LANGUAGE DefaultSignatures      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE QuantifiedConstraints  #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeFamilyDependencies #-}
-- MonadAsync's ReaderT instance is undecidable.
{-# LANGUAGE UndecidableInstances   #-}
module Control.Monad.Class.MonadAsync
  ( MonadAsync (..)
  , AsyncCancelled (..)
  , ExceptionInLinkedThread (..)
  , link
  , linkOnly
  , link2
  , link2Only
  , mapConcurrently
  , forConcurrently
  , mapConcurrently_
  , forConcurrently_
  , replicateConcurrently
  , replicateConcurrently_
  , Concurrently (..)
  ) where

import           Prelude hiding (read)

#if MIN_VERSION_base(4,18,0)
import           Control.Applicative (Alternative (..))
#else
import           Control.Applicative (Alternative (..), liftA2)
#endif
import           Control.Monad (forever)
import           Control.Monad.Class.MonadFork
import           Control.Monad.Class.MonadSTM
import           Control.Monad.Class.MonadThrow
import           Control.Monad.Class.MonadTimer

import           Control.Monad.Reader (ReaderT (..))
import           Control.Monad.Trans (lift)

import           Control.Concurrent.Async (AsyncCancelled (..))
import qualified Control.Concurrent.Async as Async
import qualified Control.Exception as E

import           Data.Bifunctor (first)
import           Data.Foldable (fold)
import           Data.Functor (void)
import           Data.Kind (Type)

class ( MonadSTM m
      , MonadThread m
      ) => MonadAsync m where

  {-# MINIMAL async, asyncBound, asyncOn, asyncThreadId, cancel, cancelWith,
              asyncWithUnmask, asyncOnWithUnmask, waitCatchSTM, pollSTM #-}

  -- | An asynchronous action
  --
  -- See 'Async.Async'.
  type Async m          = (async :: Type -> Type) | async -> m

  -- | See 'Async.async'.
  async                 :: m a -> m (Async m a)
  -- | See 'Async.asyncBound'.
  asyncBound            :: m a -> m (Async m a)
  -- | See 'Async.asyncOn'.
  asyncOn               :: Int -> m a -> m (Async m a)
  -- | See 'Async.asyncThreadId'.
  asyncThreadId         :: Async m a -> ThreadId m
  -- | See 'Async.withAsync'.
  withAsync             :: m a -> (Async m a -> m b) -> m b
  -- | See 'Async.withAsyncBound'.
  withAsyncBound        :: m a -> (Async m a -> m b) -> m b
  -- | See 'Async.withAsyncOn'.
  withAsyncOn           :: Int -> m a -> (Async m a -> m b) -> m b

  -- | See 'Async.waitSTM'.
  waitSTM               :: Async m a -> STM m a
  -- | See 'Async.pollSTM'.
  pollSTM               :: Async m a -> STM m (Maybe (Either SomeException a))
  -- | See 'Async.waitCatchSTM'.
  waitCatchSTM          :: Async m a -> STM m (Either SomeException a)

  default waitSTM :: MonadThrow (STM m) => Async m a -> STM m a
  waitSTM Async m a
action = forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM Async m a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a.
(MonadSTM m, MonadThrow (STM m), Exception e) =>
e -> STM m a
throwSTM forall (m :: * -> *) a. Monad m => a -> m a
return

  -- | See 'Async.waitAnySTM'.
  waitAnySTM            :: [Async m a] -> STM m (Async m a, a)
  -- | See 'Async.waitAnyCatchSTM'.
  waitAnyCatchSTM       :: [Async m a] -> STM m (Async m a, Either SomeException a)
  -- | See 'Async.waitEitherSTM'.
  waitEitherSTM         :: Async m a -> Async m b -> STM m (Either a b)
  -- | See 'Async.waitEitherSTM_'.
  waitEitherSTM_        :: Async m a -> Async m b -> STM m ()
  -- | See 'Async.waitEitherCatchSTM'.
  waitEitherCatchSTM    :: Async m a -> Async m b
                        -> STM m (Either (Either SomeException a)
                                         (Either SomeException b))
  -- | See 'Async.waitBothSTM'.
  waitBothSTM           :: Async m a -> Async m b -> STM m (a, b)

  -- | See 'Async.wait'.
  wait                  :: Async m a -> m a
  -- | See 'Async.poll'.
  poll                  :: Async m a -> m (Maybe (Either SomeException a))
  -- | See 'Async.waitCatch'.
  waitCatch             :: Async m a -> m (Either SomeException a)
  -- | See 'Async.cancel'.
  cancel                :: Async m a -> m ()
  -- | See 'Async.cancelWith'.
  cancelWith            :: Exception e => Async m a -> e -> m ()
  -- | See 'Async.uninterruptibleCancel'.
  uninterruptibleCancel :: Async m a -> m ()

  -- | See 'Async.waitAny'.
  waitAny               :: [Async m a] -> m (Async m a, a)
  -- | See 'Async.waitAnyCatch'.
  waitAnyCatch          :: [Async m a] -> m (Async m a, Either SomeException a)
  -- | See 'Async.waitAnyCancel'.
  waitAnyCancel         :: [Async m a] -> m (Async m a, a)
  -- | See 'Async.waitAnyCatchCancel'.
  waitAnyCatchCancel    :: [Async m a] -> m (Async m a, Either SomeException a)
  -- | See 'Async.waitEither'.
  waitEither            :: Async m a -> Async m b -> m (Either a b)

  default waitAnySTM     :: MonadThrow (STM m) => [Async m a] -> STM m (Async m a, a)
  default waitEitherSTM  :: MonadThrow (STM m) => Async m a -> Async m b -> STM m (Either a b)
  default waitEitherSTM_ :: MonadThrow (STM m) => Async m a -> Async m b -> STM m ()
  default waitBothSTM    :: MonadThrow (STM m) => Async m a -> Async m b -> STM m (a, b)

  waitAnySTM [Async m a]
as =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
orElse forall (m :: * -> *) a. MonadSTM m => STM m a
retry forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (\Async m a
a -> do a
r <- forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m a
a; forall (m :: * -> *) a. Monad m => a -> m a
return (Async m a
a, a
r)) [Async m a]
as

  waitAnyCatchSTM [Async m a]
as =
    forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
orElse forall (m :: * -> *) a. MonadSTM m => STM m a
retry forall a b. (a -> b) -> a -> b
$
      forall a b. (a -> b) -> [a] -> [b]
map (\Async m a
a -> do Either SomeException a
r <- forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM Async m a
a; forall (m :: * -> *) a. Monad m => a -> m a
return (Async m a
a, Either SomeException a
r)) [Async m a]
as

  waitEitherSTM Async m a
left Async m b
right =
    (forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m a
left)
      forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse`
    (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m b
right)

  waitEitherSTM_ Async m a
left Async m b
right =
      (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m a
left)
        forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse`
      (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m b
right)

  waitEitherCatchSTM Async m a
left Async m b
right =
      (forall a b. a -> Either a b
Left  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM Async m a
left)
        forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse`
      (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM Async m b
right)

  waitBothSTM Async m a
left Async m b
right = do
      a
a <- forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m a
left
             forall (m :: * -> *) a. MonadSTM m => STM m a -> STM m a -> STM m a
`orElse`
           (forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m b
right forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadSTM m => STM m a
retry)
      b
b <- forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM Async m b
right
      forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)

  -- | Note, IO-based implementations should override the default
  -- implementation. See the @async@ package implementation and comments.
  -- <http://hackage.haskell.org/package/async-2.2.1/docs/src/Control.Concurrent.Async.html#waitEitherCatch>
  --
  -- See 'Async.waitEitherCatch'.
  waitEitherCatch       :: Async m a -> Async m b -> m (Either (Either SomeException a)
                                                               (Either SomeException b))
  -- | See 'Async.waitEitherCancel'.
  waitEitherCancel      :: Async m a -> Async m b -> m (Either a b)
  -- | See 'Async.waitEitherCatchCancel'.
  waitEitherCatchCancel :: Async m a -> Async m b -> m (Either (Either SomeException a)
                                                               (Either SomeException b))
  -- | See 'Async.waitEither_'.
  waitEither_           :: Async m a -> Async m b -> m ()
  -- | See 'Async.waitBoth'.
  waitBoth              :: Async m a -> Async m b -> m (a, b)

  -- | See 'Async.race'.
  race                  :: m a -> m b -> m (Either a b)
  -- | See 'Async.race_'.
  race_                 :: m a -> m b -> m ()
  -- | See 'Async.concurrently'.
  concurrently          :: m a -> m b -> m (a,b)
  -- | See 'Async.concurrently_'.
  concurrently_         :: m a -> m b -> m ()

  -- | See 'Async.concurrently_'.
  asyncWithUnmask       :: ((forall b . m b -> m b) ->  m a) -> m (Async m a)
  -- | See 'Async.asyncOnWithUnmask'.
  asyncOnWithUnmask     :: Int -> ((forall b . m b -> m b) ->  m a) -> m (Async m a)
  -- | See 'Async.withAsyncWithUnmask'.
  withAsyncWithUnmask   :: ((forall c. m c -> m c) ->  m a) -> (Async m a -> m b) -> m b
  -- | See 'Async.withAsyncOnWithUnmask'.
  withAsyncOnWithUnmask :: Int -> ((forall c. m c -> m c) ->  m a) -> (Async m a -> m b) -> m b

  -- | See 'Async.compareAsyncs'.
  compareAsyncs         :: Async m a -> Async m b -> Ordering

  -- default implementations
  default withAsync     :: MonadMask m => m a -> (Async m a -> m b) -> m b
  default withAsyncBound:: MonadMask m => m a -> (Async m a -> m b) -> m b
  default withAsyncOn   :: MonadMask m => Int -> m a -> (Async m a -> m b) -> m b
  default withAsyncWithUnmask
                        :: MonadMask m => ((forall c. m c -> m c) ->  m a)
                                       -> (Async m a -> m b) -> m b
  default withAsyncOnWithUnmask
                        :: MonadMask m => Int
                                       -> ((forall c. m c -> m c) ->  m a)
                                       -> (Async m a -> m b) -> m b
  default uninterruptibleCancel
                        :: MonadMask m => Async m a -> m ()
  default waitAnyCancel         :: MonadThrow m => [Async m a] -> m (Async m a, a)
  default waitAnyCatchCancel    :: MonadThrow m => [Async m a]
                                -> m (Async m a, Either SomeException a)
  default waitEitherCancel      :: MonadThrow m => Async m a -> Async m b
                                -> m (Either a b)
  default waitEitherCatchCancel :: MonadThrow m => Async m a -> Async m b
                                -> m (Either (Either SomeException a)
                                             (Either SomeException b))
  default compareAsyncs         :: Ord (ThreadId m)
                                => Async m a -> Async m b -> Ordering

  withAsync m a
action Async m a -> m b
inner = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
                             Async m a
a <- forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (forall a. m a -> m a
restore m a
action)
                             forall a. m a -> m a
restore (Async m a -> m b
inner Async m a
a)
                               forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel Async m a
a

  withAsyncBound m a
action Async m a -> m b
inner = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
                                  Async m a
a <- forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
asyncBound (forall a. m a -> m a
restore m a
action)
                                  forall a. m a -> m a
restore (Async m a -> m b
inner Async m a
a)
                                    forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel Async m a
a

  withAsyncOn Int
n m a
action Async m a -> m b
inner = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
                                 Async m a
a <- forall (m :: * -> *) a. MonadAsync m => Int -> m a -> m (Async m a)
asyncOn Int
n (forall a. m a -> m a
restore m a
action)
                                 forall a. m a -> m a
restore (Async m a -> m b
inner Async m a
a)
                                   forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel Async m a
a


  withAsyncWithUnmask (forall a. m a -> m a) -> m a
action Async m a -> m b
inner = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
                                       Async m a
a <- forall (m :: * -> *) a.
MonadAsync m =>
((forall a. m a -> m a) -> m a) -> m (Async m a)
asyncWithUnmask (forall a. m a -> m a) -> m a
action
                                       forall a. m a -> m a
restore (Async m a -> m b
inner Async m a
a)
                                         forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel Async m a
a

  withAsyncOnWithUnmask Int
n (forall a. m a -> m a) -> m a
action Async m a -> m b
inner = forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
                                           Async m a
a <- forall (m :: * -> *) a.
MonadAsync m =>
Int -> ((forall a. m a -> m a) -> m a) -> m (Async m a)
asyncOnWithUnmask Int
n (forall a. m a -> m a) -> m a
action
                                           forall a. m a -> m a
restore (Async m a -> m b
inner Async m a
a)
                                             forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel Async m a
a

  wait      = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadAsync m => Async m a -> STM m a
waitSTM
  poll      = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Maybe (Either SomeException a))
pollSTM
  waitCatch = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM

  uninterruptibleCancel      = forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel

  waitAny                    = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> STM m (Async m a, a)
waitAnySTM
  waitAnyCatch               = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> STM m (Async m a, Either SomeException a)
waitAnyCatchSTM
  waitEither      Async m a
left Async m b
right = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> STM m (Either a b)
waitEitherSTM Async m a
left Async m b
right)
  waitEither_     Async m a
left Async m b
right = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> STM m ()
waitEitherSTM_ Async m a
left Async m b
right)
  waitEitherCatch Async m a
left Async m b
right = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> STM m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchSTM Async m a
left Async m b
right)
  waitBoth        Async m a
left Async m b
right = forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> STM m (a, b)
waitBothSTM Async m a
left Async m b
right)

  waitAnyCancel [Async m a]
asyncs =
    forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
waitAny [Async m a]
asyncs forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel [Async m a]
asyncs

  waitAnyCatchCancel [Async m a]
asyncs =
    forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, Either SomeException a)
waitAnyCatch [Async m a]
asyncs forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel [Async m a]
asyncs

  waitEitherCancel Async m a
left Async m b
right =
    forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (Either a b)
waitEither Async m a
left Async m b
right forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` (forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async m a
left forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async m b
right)

  waitEitherCatchCancel Async m a
left Async m b
right =
    forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async m a
left Async m b
right forall (m :: * -> *) a b. MonadThrow m => m a -> m b -> m a
`finally` (forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async m a
left forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel Async m b
right)

  race            m a
left m b
right = forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m a
left  forall a b. (a -> b) -> a -> b
$ \Async m a
a ->
                               forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async m b
b ->
                                 forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (Either a b)
waitEither Async m a
a Async m b
b

  race_           m a
left m b
right = forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m a
left  forall a b. (a -> b) -> a -> b
$ \Async m a
a ->
                               forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async m b
b ->
                                 forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m ()
waitEither_ Async m a
a Async m b
b

  concurrently    m a
left m b
right = forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m a
left  forall a b. (a -> b) -> a -> b
$ \Async m a
a ->
                               forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async m b
b ->
                                 forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (a, b)
waitBoth Async m a
a Async m b
b

  concurrently_   m a
left m b
right = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m (a, b)
concurrently m a
left m b
right

  compareAsyncs Async m a
a Async m b
b = forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m a
a forall a. Ord a => a -> a -> Ordering
`compare` forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m b
b

-- | Similar to 'Async.Concurrently' but which works for any 'MonadAsync'
-- instance.
--
newtype Concurrently m a = Concurrently { forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently :: m a }

instance Functor m => Functor (Concurrently m) where
    fmap :: forall a b. (a -> b) -> Concurrently m a -> Concurrently m b
fmap a -> b
f (Concurrently m a
ma) = forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f m a
ma)

instance MonadAsync m => Applicative (Concurrently m) where
    pure :: forall a. a -> Concurrently m a
pure = forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure

    Concurrently m (a -> b)
fn <*> :: forall a b.
Concurrently m (a -> b) -> Concurrently m a -> Concurrently m b
<*> Concurrently m a
as =
      forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall a b. (a -> b) -> a -> b
$
        (\(a -> b
f, a
a) -> a -> b
f a
a)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`
        forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m (a, b)
concurrently m (a -> b)
fn m a
as

instance ( MonadAsync  m
         , MonadTimer  m
         ) => Alternative (Concurrently m) where
    empty :: forall a. Concurrently m a
empty = forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (forall (m :: * -> *). MonadDelay m => Int -> m ()
threadDelay Int
86400)
    Concurrently m a
as <|> :: forall a. Concurrently m a -> Concurrently m a -> Concurrently m a
<|> Concurrently m a
bs =
      forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall a b. (a -> b) -> a -> b
$ forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
as forall (m :: * -> *) a b.
MonadAsync m =>
m a -> m b -> m (Either a b)
`race` m a
bs

instance ( Semigroup  a
         , MonadAsync m
         ) => Semigroup (Concurrently m a) where
    <> :: Concurrently m a -> Concurrently m a -> Concurrently m a
(<>) = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>)

instance ( Monoid a
         , MonadAsync m
         ) => Monoid (Concurrently m a) where
    mempty :: Concurrently m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty


-- | See 'Async.mapConcurrently'.
mapConcurrently :: (Traversable t, MonadAsync m) => (a -> m b) -> t a -> m (t b)
mapConcurrently :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadAsync m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently a -> m b
f = forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)

-- | See 'Async.forConcurrently'.
forConcurrently :: (Traversable t, MonadAsync m) => t a -> (a -> m b) -> m (t b)
forConcurrently :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadAsync m) =>
t a -> (a -> m b) -> m (t b)
forConcurrently = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadAsync m) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently

-- | See 'Async.mapConcurrently_'.
mapConcurrently_ :: (Foldable f, MonadAsync m) => (a -> m b) -> f a -> m ()
mapConcurrently_ :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, MonadAsync m) =>
(a -> m b) -> f a -> m ()
mapConcurrently_ a -> m b
f = forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)

-- | See 'Async.forConcurrently_'.
forConcurrently_ :: (Foldable f, MonadAsync m) => f a -> (a -> m b) -> m ()
forConcurrently_ :: forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, MonadAsync m) =>
f a -> (a -> m b) -> m ()
forConcurrently_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, MonadAsync m) =>
(a -> m b) -> f a -> m ()
mapConcurrently_

-- | See 'Async.replicateConcurrently'.
replicateConcurrently :: MonadAsync m => Int -> m a -> m [a]
replicateConcurrently :: forall (m :: * -> *) a. MonadAsync m => Int -> m a -> m [a]
replicateConcurrently Int
cnt = forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
cnt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently

-- | See 'Async.replicateConcurrently_'.
replicateConcurrently_ :: MonadAsync m => Int -> m a -> m ()
replicateConcurrently_ :: forall (m :: * -> *) a. MonadAsync m => Int -> m a -> m ()
replicateConcurrently_ Int
cnt = forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> a -> [a]
replicate Int
cnt forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void


--
-- Instance for IO uses the existing async library implementations
--

instance MonadAsync IO where

  type Async IO         = Async.Async

  async :: forall a. IO a -> IO (Async IO a)
async                 = forall a. IO a -> IO (Async a)
Async.async
  asyncBound :: forall a. IO a -> IO (Async IO a)
asyncBound            = forall a. IO a -> IO (Async a)
Async.asyncBound
  asyncOn :: forall a. Int -> IO a -> IO (Async IO a)
asyncOn               = forall a. Int -> IO a -> IO (Async a)
Async.asyncOn
  asyncThreadId :: forall a. Async IO a -> ThreadId IO
asyncThreadId         = forall a. Async a -> ThreadId
Async.asyncThreadId
  withAsync :: forall a b. IO a -> (Async IO a -> IO b) -> IO b
withAsync             = forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync
  withAsyncBound :: forall a b. IO a -> (Async IO a -> IO b) -> IO b
withAsyncBound        = forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsyncBound
  withAsyncOn :: forall a b. Int -> IO a -> (Async IO a -> IO b) -> IO b
withAsyncOn           = forall a b. Int -> IO a -> (Async a -> IO b) -> IO b
Async.withAsyncOn

  waitSTM :: forall a. Async IO a -> STM IO a
waitSTM               = forall a. Async a -> STM a
Async.waitSTM
  pollSTM :: forall a. Async IO a -> STM IO (Maybe (Either SomeException a))
pollSTM               = forall a. Async a -> STM (Maybe (Either SomeException a))
Async.pollSTM
  waitCatchSTM :: forall a. Async IO a -> STM IO (Either SomeException a)
waitCatchSTM          = forall a. Async a -> STM (Either SomeException a)
Async.waitCatchSTM

  waitAnySTM :: forall a. [Async IO a] -> STM IO (Async IO a, a)
waitAnySTM            = forall a. [Async a] -> STM (Async a, a)
Async.waitAnySTM
  waitAnyCatchSTM :: forall a.
[Async IO a] -> STM IO (Async IO a, Either SomeException a)
waitAnyCatchSTM       = forall a. [Async a] -> STM (Async a, Either SomeException a)
Async.waitAnyCatchSTM
  waitEitherSTM :: forall a b. Async IO a -> Async IO b -> STM IO (Either a b)
waitEitherSTM         = forall a b. Async a -> Async b -> STM (Either a b)
Async.waitEitherSTM
  waitEitherSTM_ :: forall a b. Async IO a -> Async IO b -> STM IO ()
waitEitherSTM_        = forall a b. Async a -> Async b -> STM ()
Async.waitEitherSTM_
  waitEitherCatchSTM :: forall a b.
Async IO a
-> Async IO b
-> STM
     IO (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchSTM    = forall a b.
Async a
-> Async b
-> STM (Either (Either SomeException a) (Either SomeException b))
Async.waitEitherCatchSTM
  waitBothSTM :: forall a b. Async IO a -> Async IO b -> STM IO (a, b)
waitBothSTM           = forall a b. Async a -> Async b -> STM (a, b)
Async.waitBothSTM

  wait :: forall a. Async IO a -> IO a
wait                  = forall a. Async a -> IO a
Async.wait
  poll :: forall a. Async IO a -> IO (Maybe (Either SomeException a))
poll                  = forall a. Async a -> IO (Maybe (Either SomeException a))
Async.poll
  waitCatch :: forall a. Async IO a -> IO (Either SomeException a)
waitCatch             = forall a. Async a -> IO (Either SomeException a)
Async.waitCatch
  cancel :: forall a. Async IO a -> IO ()
cancel                = forall a. Async a -> IO ()
Async.cancel
  cancelWith :: forall e a. Exception e => Async IO a -> e -> IO ()
cancelWith            = forall e a. Exception e => Async a -> e -> IO ()
Async.cancelWith
  uninterruptibleCancel :: forall a. Async IO a -> IO ()
uninterruptibleCancel = forall a. Async a -> IO ()
Async.uninterruptibleCancel

  waitAny :: forall a. [Async IO a] -> IO (Async IO a, a)
waitAny               = forall a. [Async a] -> IO (Async a, a)
Async.waitAny
  waitAnyCatch :: forall a. [Async IO a] -> IO (Async IO a, Either SomeException a)
waitAnyCatch          = forall a. [Async a] -> IO (Async a, Either SomeException a)
Async.waitAnyCatch
  waitAnyCancel :: forall a. [Async IO a] -> IO (Async IO a, a)
waitAnyCancel         = forall a. [Async a] -> IO (Async a, a)
Async.waitAnyCancel
  waitAnyCatchCancel :: forall a. [Async IO a] -> IO (Async IO a, Either SomeException a)
waitAnyCatchCancel    = forall a. [Async a] -> IO (Async a, Either SomeException a)
Async.waitAnyCatchCancel
  waitEither :: forall a b. Async IO a -> Async IO b -> IO (Either a b)
waitEither            = forall a b. Async a -> Async b -> IO (Either a b)
Async.waitEither
  waitEitherCatch :: forall a b.
Async IO a
-> Async IO b
-> IO (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch       = forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
Async.waitEitherCatch
  waitEitherCancel :: forall a b. Async IO a -> Async IO b -> IO (Either a b)
waitEitherCancel      = forall a b. Async a -> Async b -> IO (Either a b)
Async.waitEitherCancel
  waitEitherCatchCancel :: forall a b.
Async IO a
-> Async IO b
-> IO (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel = forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
Async.waitEitherCatchCancel
  waitEither_ :: forall a b. Async IO a -> Async IO b -> IO ()
waitEither_           = forall a b. Async a -> Async b -> IO ()
Async.waitEither_
  waitBoth :: forall a b. Async IO a -> Async IO b -> IO (a, b)
waitBoth              = forall a b. Async a -> Async b -> IO (a, b)
Async.waitBoth

  race :: forall a b. IO a -> IO b -> IO (Either a b)
race                  = forall a b. IO a -> IO b -> IO (Either a b)
Async.race
  race_ :: forall a b. IO a -> IO b -> IO ()
race_                 = forall a b. IO a -> IO b -> IO ()
Async.race_
  concurrently :: forall a b. IO a -> IO b -> IO (a, b)
concurrently          = forall a b. IO a -> IO b -> IO (a, b)
Async.concurrently
  concurrently_ :: forall a b. IO a -> IO b -> IO ()
concurrently_         = forall a b. IO a -> IO b -> IO ()
Async.concurrently_

  asyncWithUnmask :: forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async IO a)
asyncWithUnmask       = forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
Async.asyncWithUnmask
  asyncOnWithUnmask :: forall a.
Int -> ((forall b. IO b -> IO b) -> IO a) -> IO (Async IO a)
asyncOnWithUnmask     = forall a. Int -> ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
Async.asyncOnWithUnmask
  withAsyncWithUnmask :: forall a b.
((forall b. IO b -> IO b) -> IO a) -> (Async IO a -> IO b) -> IO b
withAsyncWithUnmask   = forall a b.
((forall b. IO b -> IO b) -> IO a) -> (Async a -> IO b) -> IO b
Async.withAsyncWithUnmask
  withAsyncOnWithUnmask :: forall a b.
Int
-> ((forall b. IO b -> IO b) -> IO a)
-> (Async IO a -> IO b)
-> IO b
withAsyncOnWithUnmask = forall a b.
Int
-> ((forall b. IO b -> IO b) -> IO a) -> (Async a -> IO b) -> IO b
Async.withAsyncOnWithUnmask

  compareAsyncs :: forall a b. Async IO a -> Async IO b -> Ordering
compareAsyncs         = forall a b. Async a -> Async b -> Ordering
Async.compareAsyncs


--
-- Linking
--
-- Adapted from "Control.Concurrent.Async"
--
-- We don't use the implementation of linking from 'Control.Concurrent.Async'
-- directly because  if we /did/ use the real implementation, then the mock
-- implementation and the real implementation would not be able to throw the
-- same exception, because the exception type used by the real implementation
-- is
--
-- > data ExceptionInLinkedThread =
-- >   forall a . ExceptionInLinkedThread (Async a) SomeException
--
--    containing a reference to the real 'Async' type.
--

-- | Exception from child thread re-raised in parent thread
--
-- We record the thread ID of the child thread as a 'String'. This avoids
-- an @m@ parameter in the type, which is important: 'ExceptionInLinkedThread'
-- must be an instance of 'Exception', requiring it to be 'Typeable'; if @m@
-- appeared in the type, we would require @m@ to be 'Typeable', which does not
-- work with with the simulator, as it would require a 'Typeable' constraint
-- on the @s@ parameter of 'IOSim'.
data ExceptionInLinkedThread = ExceptionInLinkedThread String SomeException

instance Show ExceptionInLinkedThread where
  showsPrec :: Int -> ExceptionInLinkedThread -> ShowS
showsPrec Int
p (ExceptionInLinkedThread String
a SomeException
e) =
    Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
>= Int
11) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"ExceptionInLinkedThread " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
a forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      String -> ShowS
showString String
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 SomeException
e

instance Exception ExceptionInLinkedThread where
  fromException :: SomeException -> Maybe ExceptionInLinkedThread
fromException = forall e. Exception e => SomeException -> Maybe e
E.asyncExceptionFromException
  toException :: ExceptionInLinkedThread -> SomeException
toException = forall e. Exception e => e -> SomeException
E.asyncExceptionToException

-- | Like 'Async.link'.
link :: (MonadAsync m, MonadFork m, MonadMask m)
     => Async m a -> m ()
link :: forall (m :: * -> *) a.
(MonadAsync m, MonadFork m, MonadMask m) =>
Async m a -> m ()
link = forall (m :: * -> *) a.
(MonadAsync m, MonadFork m, MonadMask m) =>
(SomeException -> Bool) -> Async m a -> m ()
linkOnly (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Bool
isCancel)

-- | Like 'Async.linkOnly'.
linkOnly :: forall m a. (MonadAsync m, MonadFork m, MonadMask m)
         => (SomeException -> Bool) -> Async m a -> m ()
linkOnly :: forall (m :: * -> *) a.
(MonadAsync m, MonadFork m, MonadMask m) =>
(SomeException -> Bool) -> Async m a -> m ()
linkOnly SomeException -> Bool
shouldThrow Async m a
a = do
    ThreadId m
tid <- forall (m :: * -> *). MonadThread m => m (ThreadId m)
myThreadId
    forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadFork m, MonadMask m) =>
String -> m a -> m (ThreadId m)
forkRepeat (String
"linkToOnly " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ThreadId m
linkedThreadId) forall a b. (a -> b) -> a -> b
$ do
      Either SomeException a
r <- forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Either SomeException a)
waitCatch Async m a
a
      case Either SomeException a
r of
        Left SomeException
e | SomeException -> Bool
shouldThrow SomeException
e -> forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tid (SomeException -> ExceptionInLinkedThread
exceptionInLinkedThread SomeException
e)
        Either SomeException a
_otherwise             -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    linkedThreadId :: ThreadId m
    linkedThreadId :: ThreadId m
linkedThreadId = forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m a
a

    exceptionInLinkedThread :: SomeException -> ExceptionInLinkedThread
    exceptionInLinkedThread :: SomeException -> ExceptionInLinkedThread
exceptionInLinkedThread =
        String -> SomeException -> ExceptionInLinkedThread
ExceptionInLinkedThread (forall a. Show a => a -> String
show ThreadId m
linkedThreadId)

-- | Like 'Async.link2'.
link2 :: (MonadAsync m, MonadFork m, MonadMask m)
      => Async m a -> Async m b -> m ()
link2 :: forall (m :: * -> *) a b.
(MonadAsync m, MonadFork m, MonadMask m) =>
Async m a -> Async m b -> m ()
link2 = forall (m :: * -> *) a b.
(MonadAsync m, MonadFork m, MonadMask m) =>
(SomeException -> Bool) -> Async m a -> Async m b -> m ()
link2Only (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Bool
isCancel)

-- | Like 'Async.link2Only'.
link2Only :: (MonadAsync m, MonadFork m, MonadMask m)
          => (SomeException -> Bool) -> Async m a -> Async m b -> m ()
link2Only :: forall (m :: * -> *) a b.
(MonadAsync m, MonadFork m, MonadMask m) =>
(SomeException -> Bool) -> Async m a -> Async m b -> m ()
link2Only SomeException -> Bool
shouldThrow Async m a
left  Async m b
right =
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadFork m, MonadMask m) =>
String -> m a -> m (ThreadId m)
forkRepeat (String
"link2Only " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (ThreadId m
tl, ThreadId m
tr)) forall a b. (a -> b) -> a -> b
$ do
    Either (Either SomeException a) (Either SomeException b)
r <- forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async m a
left Async m b
right
    case Either (Either SomeException a) (Either SomeException b)
r of
      Left  (Left SomeException
e) | SomeException -> Bool
shouldThrow SomeException
e ->
        forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tr (String -> SomeException -> ExceptionInLinkedThread
ExceptionInLinkedThread (forall a. Show a => a -> String
show ThreadId m
tl) SomeException
e)
      Right (Left SomeException
e) | SomeException -> Bool
shouldThrow SomeException
e ->
        forall (m :: * -> *) e.
(MonadFork m, Exception e) =>
ThreadId m -> e -> m ()
throwTo ThreadId m
tl (String -> SomeException -> ExceptionInLinkedThread
ExceptionInLinkedThread (forall a. Show a => a -> String
show ThreadId m
tr) SomeException
e)
      Either (Either SomeException a) (Either SomeException b)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    tl :: ThreadId m
tl = forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m a
left
    tr :: ThreadId m
tr = forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m b
right

isCancel :: SomeException -> Bool
isCancel :: SomeException -> Bool
isCancel SomeException
e
  | Just AsyncCancelled
AsyncCancelled <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e = Bool
True
  | Bool
otherwise = Bool
False

forkRepeat :: (MonadFork m, MonadMask m) => String -> m a -> m (ThreadId m)
forkRepeat :: forall (m :: * -> *) a.
(MonadFork m, MonadMask m) =>
String -> m a -> m (ThreadId m)
forkRepeat String
label m a
action =
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore ->
    let go :: m ()
go = do Either SomeException a
r <- forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAll (forall a. m a -> m a
restore m a
action)
                case Either SomeException a
r of
                  Left SomeException
_ -> m ()
go
                  Either SomeException a
_      -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    in forall (m :: * -> *). MonadFork m => m () -> m (ThreadId m)
forkIO (forall (m :: * -> *). MonadThread m => String -> m ()
labelThisThread String
label forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
go)

tryAll :: MonadCatch m => m a -> m (Either SomeException a)
tryAll :: forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAll = forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try


--
-- ReaderT instance
--

newtype AsyncReaderT r (m :: Type -> Type) a =
    AsyncReaderT { forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT :: Async m a }

instance ( MonadAsync m
         , MonadCatch (STM m)
         , MonadFork m
         , MonadMask m
         ) => MonadAsync (ReaderT r m) where
    type Async (ReaderT r m) = AsyncReaderT r m
    asyncThreadId :: forall a. Async (ReaderT r m) a -> ThreadId (ReaderT r m)
asyncThreadId (AsyncReaderT Async m a
a) = forall (m :: * -> *) a. MonadAsync m => Async m a -> ThreadId m
asyncThreadId Async m a
a

    async :: forall a. ReaderT r m a -> ReaderT r m (Async (ReaderT r m) a)
async      (ReaderT r -> m a
ma)  = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
async (r -> m a
ma r
r)
    asyncBound :: forall a. ReaderT r m a -> ReaderT r m (Async (ReaderT r m) a)
asyncBound (ReaderT r -> m a
ma)  = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadAsync m => m a -> m (Async m a)
asyncBound (r -> m a
ma r
r)
    asyncOn :: forall a.
Int -> ReaderT r m a -> ReaderT r m (Async (ReaderT r m) a)
asyncOn Int
n  (ReaderT r -> m a
ma)  = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadAsync m => Int -> m a -> m (Async m a)
asyncOn Int
n (r -> m a
ma r
r)
    withAsync :: forall a b.
ReaderT r m a
-> (Async (ReaderT r m) a -> ReaderT r m b) -> ReaderT r m b
withAsync (ReaderT r -> m a
ma) Async (ReaderT r m) a -> ReaderT r m b
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsync (r -> m a
ma r
r)
                                       forall a b. (a -> b) -> a -> b
$ \Async m a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Async (ReaderT r m) a -> ReaderT r m b
f (forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT Async m a
a)) r
r
    withAsyncBound :: forall a b.
ReaderT r m a
-> (Async (ReaderT r m) a -> ReaderT r m b) -> ReaderT r m b
withAsyncBound (ReaderT r -> m a
ma) Async (ReaderT r m) a -> ReaderT r m b
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
m a -> (Async m a -> m b) -> m b
withAsyncBound (r -> m a
ma r
r)
                                       forall a b. (a -> b) -> a -> b
$ \Async m a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Async (ReaderT r m) a -> ReaderT r m b
f (forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT Async m a
a)) r
r
    withAsyncOn :: forall a b.
Int
-> ReaderT r m a
-> (Async (ReaderT r m) a -> ReaderT r m b)
-> ReaderT r m b
withAsyncOn  Int
n (ReaderT r -> m a
ma) Async (ReaderT r m) a -> ReaderT r m b
f = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
Int -> m a -> (Async m a -> m b) -> m b
withAsyncOn Int
n (r -> m a
ma r
r)
                                       forall a b. (a -> b) -> a -> b
$ \Async m a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Async (ReaderT r m) a -> ReaderT r m b
f (forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT Async m a
a)) r
r

    asyncWithUnmask :: forall a.
((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a)
-> ReaderT r m (Async (ReaderT r m) a)
asyncWithUnmask (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
f        = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT
                                             forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadAsync m =>
((forall a. m a -> m a) -> m a) -> m (Async m a)
asyncWithUnmask
                                             forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
unmask -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
f (forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF forall b. m b -> m b
unmask)) r
r
      where
        liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
        liftF :: forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF m a -> m a
g (ReaderT r -> m a
r) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
r)

    asyncOnWithUnmask :: forall a.
Int
-> ((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a)
-> ReaderT r m (Async (ReaderT r m) a)
asyncOnWithUnmask Int
n (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
f   = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT
                                            forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadAsync m =>
Int -> ((forall a. m a -> m a) -> m a) -> m (Async m a)
asyncOnWithUnmask Int
n
                                            forall a b. (a -> b) -> a -> b
$ \forall b. m b -> m b
unmask -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
f (forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF forall b. m b -> m b
unmask)) r
r
      where
        liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
        liftF :: forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF m a -> m a
g (ReaderT r -> m a
r) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
r)

    withAsyncWithUnmask :: forall a b.
((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a)
-> (Async (ReaderT r m) a -> ReaderT r m b) -> ReaderT r m b
withAsyncWithUnmask (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
action Async (ReaderT r m) a -> ReaderT r m b
f  =
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
((forall a. m a -> m a) -> m a) -> (Async m a -> m b) -> m b
withAsyncWithUnmask (\forall b. m b -> m b
unmask -> case (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
action (forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF forall b. m b -> m b
unmask) of
                                                        ReaderT r -> m a
ma -> r -> m a
ma r
r)
              forall a b. (a -> b) -> a -> b
$ \Async m a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Async (ReaderT r m) a -> ReaderT r m b
f (forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT Async m a
a)) r
r
      where
        liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
        liftF :: forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF m a -> m a
g (ReaderT r -> m a
r) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
r)

    withAsyncOnWithUnmask :: forall a b.
Int
-> ((forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a)
-> (Async (ReaderT r m) a -> ReaderT r m b)
-> ReaderT r m b
withAsyncOnWithUnmask Int
n (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
action Async (ReaderT r m) a -> ReaderT r m b
f  =
      forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
Int -> ((forall a. m a -> m a) -> m a) -> (Async m a -> m b) -> m b
withAsyncOnWithUnmask Int
n (\forall b. m b -> m b
unmask -> case (forall b. ReaderT r m b -> ReaderT r m b) -> ReaderT r m a
action (forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF forall b. m b -> m b
unmask) of
                                                            ReaderT r -> m a
ma -> r -> m a
ma r
r)
              forall a b. (a -> b) -> a -> b
$ \Async m a
a -> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Async (ReaderT r m) a -> ReaderT r m b
f (forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT Async m a
a)) r
r
      where
        liftF :: (m a -> m a) -> ReaderT r m a -> ReaderT r m a
        liftF :: forall a. (m a -> m a) -> ReaderT r m a -> ReaderT r m a
liftF m a -> m a
g (ReaderT r -> m a
r) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (m a -> m a
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> m a
r)

    waitCatchSTM :: forall a.
Async (ReaderT r m) a -> STM (ReaderT r m) (Either SomeException a)
waitCatchSTM = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Either SomeException a)
waitCatchSTM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    pollSTM :: forall a.
Async (ReaderT r m) a
-> STM (ReaderT r m) (Maybe (Either SomeException a))
pollSTM      = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> STM m (Maybe (Either SomeException a))
pollSTM      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT

    race :: forall a b.
ReaderT r m a -> ReaderT r m b -> ReaderT r m (Either a b)
race         (ReaderT r -> m a
ma) (ReaderT r -> m b
mb) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b.
MonadAsync m =>
m a -> m b -> m (Either a b)
race  (r -> m a
ma r
r) (r -> m b
mb r
r)
    race_ :: forall a b. ReaderT r m a -> ReaderT r m b -> ReaderT r m ()
race_        (ReaderT r -> m a
ma) (ReaderT r -> m b
mb) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m ()
race_ (r -> m a
ma r
r) (r -> m b
mb r
r)
    concurrently :: forall a b. ReaderT r m a -> ReaderT r m b -> ReaderT r m (a, b)
concurrently (ReaderT r -> m a
ma) (ReaderT r -> m b
mb) = forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT forall a b. (a -> b) -> a -> b
$ \r
r -> forall (m :: * -> *) a b. MonadAsync m => m a -> m b -> m (a, b)
concurrently (r -> m a
ma r
r) (r -> m b
mb r
r)

    wait :: forall a. Async (ReaderT r m) a -> ReaderT r m a
wait                  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadAsync m => Async m a -> m a
wait         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    poll :: forall a.
Async (ReaderT r m) a
-> ReaderT r m (Maybe (Either SomeException a))
poll                  = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Maybe (Either SomeException a))
poll         forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitCatch :: forall a.
Async (ReaderT r m) a -> ReaderT r m (Either SomeException a)
waitCatch             = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a.
MonadAsync m =>
Async m a -> m (Either SomeException a)
waitCatch    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    cancel :: forall a. Async (ReaderT r m) a -> ReaderT r m ()
cancel                = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
cancel       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    uninterruptibleCancel :: forall a. Async (ReaderT r m) a -> ReaderT r m ()
uninterruptibleCancel = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall (m :: * -> *) a. MonadAsync m => Async m a -> m ()
uninterruptibleCancel
                                                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    cancelWith :: forall e a.
Exception e =>
Async (ReaderT r m) a -> e -> ReaderT r m ()
cancelWith            = (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) e a.
(MonadAsync m, Exception e) =>
Async m a -> e -> m ()
cancelWith)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitAny :: forall a.
[Async (ReaderT r m) a] -> ReaderT r m (Async (ReaderT r m) a, a)
waitAny               = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
waitAny
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitAnyCatch :: forall a.
[Async (ReaderT r m) a]
-> ReaderT r m (Async (ReaderT r m) a, Either SomeException a)
waitAnyCatch          = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, Either SomeException a)
waitAnyCatch
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitAnyCancel :: forall a.
[Async (ReaderT r m) a] -> ReaderT r m (Async (ReaderT r m) a, a)
waitAnyCancel         = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, a)
waitAnyCancel
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitAnyCatchCancel :: forall a.
[Async (ReaderT r m) a]
-> ReaderT r m (Async (ReaderT r m) a, Either SomeException a)
waitAnyCatchCancel    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall r (m :: * -> *) a. Async m a -> AsyncReaderT r m a
AsyncReaderT)
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadAsync m =>
[Async m a] -> m (Async m a, Either SomeException a)
waitAnyCatchCancel
                          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitEither :: forall a b.
Async (ReaderT r m) a
-> Async (ReaderT r m) b -> ReaderT r m (Either a b)
waitEither            = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (Either a b)
waitEither)            forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitEitherCatch :: forall a b.
Async (ReaderT r m) a
-> Async (ReaderT r m) b
-> ReaderT
     r m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch       = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch)       forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitEitherCancel :: forall a b.
Async (ReaderT r m) a
-> Async (ReaderT r m) b -> ReaderT r m (Either a b)
waitEitherCancel      = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (Either a b)
waitEitherCancel)      forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitEitherCatchCancel :: forall a b.
Async (ReaderT r m) a
-> Async (ReaderT r m) b
-> ReaderT
     r m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a
-> Async m b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel) forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitEither_ :: forall a b.
Async (ReaderT r m) a -> Async (ReaderT r m) b -> ReaderT r m ()
waitEither_           = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m ()
waitEither_)           forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT
    waitBoth :: forall a b.
Async (ReaderT r m) a
-> Async (ReaderT r m) b -> ReaderT r m (a, b)
waitBoth              = forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: forall (m :: * -> *) a b.
MonadAsync m =>
Async m a -> Async m b -> m (a, b)
waitBoth)              forall r (m :: * -> *) a. AsyncReaderT r m a -> Async m a
getAsyncReaderT


--
-- Utilities
--

(.:) :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
(c -> d
f .: :: forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.: a -> b -> c
g) a
x b
y = c -> d
f (a -> b -> c
g a
x b
y)


-- | A higher order version of 'Data.Function.on'
--
on :: (f a -> f b -> c)
   -> (forall x. g x -> f x)
   -> (g a -> g b -> c)
on :: forall (f :: * -> *) a b c (g :: * -> *).
(f a -> f b -> c) -> (forall x. g x -> f x) -> g a -> g b -> c
on f a -> f b -> c
f forall x. g x -> f x
g = \g a
a g b
b -> f a -> f b -> c
f (forall x. g x -> f x
g g a
a) (forall x. g x -> f x
g g b
b)