{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      : Control.Concurrent.Async.Lifted.Safe
Copyright   : Copyright (C) 2012-2018 Mitsutoshi Aoe
License     : BSD-style (see the file LICENSE)
Maintainer  : Mitsutoshi Aoe <maoe@foldr.in>
Stability   : experimental

This is a safe variant of @Control.Concurrent.Async.Lifted@.

This module assumes your monad stack to satisfy @'StM' m a ~ a@ so you can't
mess up monadic effects. If your monad stack is stateful, use
@Control.Concurrent.Async.Lifted@ with special care.
-}

module Control.Concurrent.Async.Lifted.Safe
  (
    -- * Asynchronous actions
    A.Async

  , Pure
  , Forall
    -- ** Spawning
  , async, asyncBound, asyncOn, asyncWithUnmask, asyncOnWithUnmask

    -- ** Spawning with automatic 'cancel'ation
  , withAsync, withAsyncBound, withAsyncOn
  , withAsyncWithUnmask, withAsyncOnWithUnmask

    -- ** Quering 'Async's
  , wait, poll, waitCatch
  , cancel
  , uninterruptibleCancel
  , cancelWith
  , A.asyncThreadId
  , A.AsyncCancelled(..)

    -- ** STM operations
  , A.waitSTM, A.pollSTM, A.waitCatchSTM

    -- ** Waiting for multiple 'Async's
  , waitAny, waitAnyCatch, waitAnyCancel, waitAnyCatchCancel
  , waitEither, waitEitherCatch, waitEitherCancel, waitEitherCatchCancel
  , waitEither_
  , waitBoth

    -- ** Waiting for multiple 'Async's in STM
  , A.waitAnySTM
  , A.waitAnyCatchSTM
  , A.waitEitherSTM
  , A.waitEitherCatchSTM
  , A.waitEitherSTM_
  , A.waitBothSTM

    -- ** Linking
  , Unsafe.link, Unsafe.link2
  , A.ExceptionInLinkedThread(..)

    -- * Convenient utilities
  , race, race_, concurrently, concurrently_
  , mapConcurrently, mapConcurrently_
  , forConcurrently, forConcurrently_
  , replicateConcurrently, replicateConcurrently_
  , Concurrently(..)

  , A.compareAsyncs
  )
  where

import Control.Applicative
import Control.Concurrent (threadDelay)
import Control.Monad
import Data.Foldable (fold)

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.Foldable
import Data.Traversable
#endif
#if !MIN_VERSION_base(4, 8, 0)
import Data.Monoid (Monoid(mappend, mempty))
#elif MIN_VERSION_base(4, 9, 0) && !MIN_VERSION_base(4, 13, 0)
import Data.Semigroup (Semigroup((<>)))
#endif

-- | Generalized version of 'A.async'.
async
  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m (Async a)
async :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m (Async a)
async = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
Unsafe.async
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.asyncBound'.
asyncBound
  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m (Async a)
asyncBound :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m (Async a)
asyncBound = forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
Unsafe.asyncBound
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.asyncOn'.
asyncOn
  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
  => Int -> m a -> m (Async a)
asyncOn :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
Int -> m a -> m (Async a)
asyncOn Int
cpu m a
m = forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Async (StM m a))
Unsafe.asyncOn Int
cpu m a
m
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.asyncWithUnmask'.
asyncWithUnmask
  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
  => ((forall b. m b -> m b) -> m a)
  -> m (Async a)
asyncWithUnmask :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
((forall b. m b -> m b) -> m a) -> m (Async a)
asyncWithUnmask (forall b. m b -> m b) -> m a
restore = forall (m :: * -> *) a.
MonadBaseControl IO m =>
((forall b. m b -> m b) -> m a) -> m (Async (StM m a))
Unsafe.asyncWithUnmask (forall b. m b -> m b) -> m a
restore
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.asyncOnWithUnmask'.
asyncOnWithUnmask
  :: forall m a. (MonadBaseControl IO m, Forall (Pure m))
  => Int
  -> ((forall b. m b -> m b) -> m a)
  -> m (Async a)
asyncOnWithUnmask :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
Int -> ((forall b. m b -> m b) -> m a) -> m (Async a)
asyncOnWithUnmask Int
cpu (forall b. m b -> m b) -> m a
restore = forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> ((forall b. m b -> m b) -> m a) -> m (Async (StM m a))
Unsafe.asyncOnWithUnmask Int
cpu (forall b. m b -> m b) -> m a
restore
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.withAsync'.
withAsync
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a
  -> (Async a -> m b)
  -> m b
withAsync :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> (Async a -> m b) -> m b
withAsync = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
Unsafe.withAsync
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.withAsyncBound'.
withAsyncBound
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a
  -> (Async a -> m b)
  -> m b
withAsyncBound :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> (Async a -> m b) -> m b
withAsyncBound = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
Unsafe.withAsyncBound
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.withAsyncOn'.
withAsyncOn
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => Int
  -> m a
  -> (Async a -> m b)
  -> m b
withAsyncOn :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
Int -> m a -> (Async a -> m b) -> m b
withAsyncOn = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Int -> m a -> (Async (StM m a) -> m b) -> m b
Unsafe.withAsyncOn
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.withAsyncWithUnmask'.
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 :: 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 (forall c. m c -> m c) -> m a
restore = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
((forall c. m c -> m c) -> m a) -> (Async (StM m a) -> m b) -> m b
Unsafe.withAsyncWithUnmask (forall c. m c -> m c) -> m a
restore
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.withAsyncOnWithUnmask'.
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 :: 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 Int
cpu (forall c. m c -> m c) -> m a
restore = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Int
-> ((forall c. m c -> m c) -> m a)
-> (Async (StM m a) -> m b)
-> m b
Unsafe.withAsyncOnWithUnmask Int
cpu (forall c. m c -> m c) -> m a
restore
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.wait'.
wait
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => Async a -> m a
wait :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> m a
wait = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO a
A.wait
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.poll'.
poll
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> m (Maybe (Either SomeException a))
poll :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> m (Maybe (Either SomeException a))
poll = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO (Maybe (Either SomeException a))
A.poll
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.waitCatch'.
waitCatch
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> m (Either SomeException a)
waitCatch :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> m (Either SomeException a)
waitCatch = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO (Either SomeException a)
A.waitCatch
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.cancel'.
cancel :: MonadBase IO m => Async a -> m ()
cancel :: forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel = forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
Unsafe.cancel

-- | Generalized version of 'A.cancelWith'.
cancelWith :: (MonadBase IO m, Exception e) => Async a -> e -> m ()
cancelWith :: forall (m :: * -> *) e a.
(MonadBase IO m, Exception e) =>
Async a -> e -> m ()
cancelWith = forall (m :: * -> *) e a.
(MonadBase IO m, Exception e) =>
Async a -> e -> m ()
Unsafe.cancelWith

-- | Generalized version of 'A.uninterruptibleCancel'.
uninterruptibleCancel :: MonadBase IO m => Async a -> m ()
uninterruptibleCancel :: forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
uninterruptibleCancel = forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
Unsafe.uninterruptibleCancel

-- | Generalized version of 'A.waitAny'.
waitAny
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => [Async a] -> m (Async a, a)
waitAny :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
[Async a] -> m (Async a, a)
waitAny = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, a)
A.waitAny
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.waitAnyCatch'.
waitAnyCatch
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => [Async a]
  -> m (Async a, Either SomeException a)
waitAnyCatch :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
[Async a] -> m (Async a, Either SomeException a)
waitAnyCatch = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatch
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.waitAnyCancel'.
waitAnyCancel
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => [Async a]
  -> m (Async a, a)
waitAnyCancel :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
[Async a] -> m (Async a, a)
waitAnyCancel = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, a)
A.waitAnyCancel
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.waitAnyCatchCancel'.
waitAnyCatchCancel
  :: forall m a. (MonadBase IO m, Forall (Pure m))
  => [Async a]
  -> m (Async a, Either SomeException a)
waitAnyCatchCancel :: forall (m :: * -> *) a.
(MonadBase IO m, Forall (Pure m)) =>
[Async a] -> m (Async a, Either SomeException a)
waitAnyCatchCancel = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatchCancel
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)

-- | Generalized version of 'A.waitEither'.
waitEither
  :: forall m a b. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> Async b
  -> m (Either a b)
waitEither :: forall (m :: * -> *) a b.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> Async b -> m (Either a b)
waitEither = (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Async a -> Async b -> IO (Either a b)
A.waitEither
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b)

-- | Generalized version of 'A.waitEitherCatch'.
waitEitherCatch
  :: forall m a b. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> Async b
  -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch :: forall (m :: * -> *) a b.
(MonadBase IO m, Forall (Pure m)) =>
Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch = (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatch
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b)

-- | Generalized version of 'A.waitEitherCancel'.
waitEitherCancel
  :: forall m a b. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> Async b
  -> m (Either a b)
waitEitherCancel :: forall (m :: * -> *) a b.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> Async b -> m (Either a b)
waitEitherCancel = (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Async a -> Async b -> IO (Either a b)
A.waitEitherCancel
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b)

-- | Generalized version of 'A.waitEitherCatchCancel'.
waitEitherCatchCancel
  :: forall m a b. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> Async b
  -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel :: forall (m :: * -> *) a b.
(MonadBase IO m, Forall (Pure m)) =>
Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel = (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatchCancel
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b)

-- | Generalized version of 'A.waitEither_'
waitEither_ :: MonadBase IO m => Async a -> Async b -> m ()
waitEither_ :: forall (m :: * -> *) a b.
MonadBase IO m =>
Async a -> Async b -> m ()
waitEither_ = forall (m :: * -> *) a b.
MonadBase IO m =>
Async a -> Async b -> m ()
Unsafe.waitEither_

-- | Generalized version of 'A.waitBoth'.
waitBoth
  :: forall m a b. (MonadBase IO m, Forall (Pure m))
  => Async a
  -> Async b
  -> m (a, b)
waitBoth :: forall (m :: * -> *) a b.
(MonadBase IO m, Forall (Pure m)) =>
Async a -> Async b -> m (a, b)
waitBoth = (forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Async a -> Async b -> IO (a, b)
A.waitBoth
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
  forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b)

-- | Generalized version of 'A.race'.
race
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m b -> m (Either a b)
race :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m (Either a b)
race = forall (base :: * -> *) (m :: * -> *) a b c.
(MonadBaseControl base m, Forall (Pure m)) =>
(base a -> base b -> base c) -> m a -> m b -> m c
liftBaseOp2_ forall a b. IO a -> IO b -> IO (Either a b)
A.race

-- | Generalized version of 'A.race_'.
race_
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m b -> m ()
race_ :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m ()
race_ = forall (base :: * -> *) (m :: * -> *) a b c.
(MonadBaseControl base m, Forall (Pure m)) =>
(base a -> base b -> base c) -> m a -> m b -> m c
liftBaseOp2_ forall a b. IO a -> IO b -> IO ()
A.race_

-- | Generalized version of 'A.concurrently'.
concurrently
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m b -> m (a, b)
concurrently :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m (a, b)
concurrently = forall (base :: * -> *) (m :: * -> *) a b c.
(MonadBaseControl base m, Forall (Pure m)) =>
(base a -> base b -> base c) -> m a -> m b -> m c
liftBaseOp2_ forall a b. IO a -> IO b -> IO (a, b)
A.concurrently

-- | Generalized version of 'A.concurrently_'.
concurrently_
  :: forall m a b. (MonadBaseControl IO m, Forall (Pure m))
  => m a -> m b -> m ()
concurrently_ :: forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m ()
concurrently_ = forall (base :: * -> *) (m :: * -> *) a b c.
(MonadBaseControl base m, Forall (Pure m)) =>
(base a -> base b -> base c) -> m a -> m b -> m c
liftBaseOp2_ forall a b. IO a -> IO b -> IO ()
A.concurrently_

-- | Similar to 'A.liftBaseOp_' but takes a binary function
-- and leverages @'StM' m a ~ a@.
liftBaseOp2_
  :: forall base m a b c. (MonadBaseControl base m, Forall (Pure m))
  => (base a -> base b -> base c)
  -> m a -> m b -> m c
liftBaseOp2_ :: forall (base :: * -> *) (m :: * -> *) a b c.
(MonadBaseControl base m, Forall (Pure m)) =>
(base a -> base b -> base c) -> m a -> m b -> m c
liftBaseOp2_ base a -> base b -> base c
f m a
left m b
right = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m base
run -> base a -> base b -> base c
f
  (RunInBase m base
run m a
left forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a))
  (RunInBase m base
run m b
right forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m b))

-- | Generalized version of 'A.mapConcurrently'.
mapConcurrently
  :: (Traversable t, MonadBaseControl IO m, Forall (Pure m))
  => (a -> m b)
  -> t a
  -> m (t b)
mapConcurrently :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m, Forall (Pure 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. Forall (Pure m) => m a -> Concurrently m a
Concurrently forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)

-- | Generalized version of 'A.mapConcurrently_'.
mapConcurrently_
  :: (Foldable t, MonadBaseControl IO m, Forall (Pure m))
  => (a -> m b)
  -> t a
  -> m ()
mapConcurrently_ :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, MonadBaseControl IO m, Forall (Pure m)) =>
(a -> m b) -> t 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. Forall (Pure m) => 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)

-- | Generalized version of 'A.forConcurrently'.
forConcurrently
  :: (Traversable t, MonadBaseControl IO m, Forall (Pure m))
  => t a
  -> (a -> m b)
  -> m (t b)
forConcurrently :: forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, MonadBaseControl IO m, Forall (Pure 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, MonadBaseControl IO m, Forall (Pure m)) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently

-- | Generalized version of 'A.forConcurrently_'.
forConcurrently_
  :: (Foldable t, MonadBaseControl IO m, Forall (Pure m))
  => t a
  -> (a -> m b)
  -> m ()
forConcurrently_ :: forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, MonadBaseControl IO m, Forall (Pure m)) =>
t a -> (a -> m b) -> m ()
forConcurrently_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, MonadBaseControl IO m, Forall (Pure m)) =>
(a -> m b) -> t a -> m ()
mapConcurrently_

-- | Generalized version of 'A.replicateConcurrently'.
replicateConcurrently
  :: (MonadBaseControl IO m, Forall (Pure m))
  => Int
  -> m a
  -> m [a]
replicateConcurrently :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
Int -> m a -> m [a]
replicateConcurrently Int
n =
  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
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Forall (Pure m) => m a -> Concurrently m a
Concurrently

-- | Generalized version of 'A.replicateConcurrently_'.
replicateConcurrently_
  :: (MonadBaseControl IO m, Forall (Pure m))
  => Int
  -> m a
  -> m ()
replicateConcurrently_ :: forall (m :: * -> *) a.
(MonadBaseControl IO m, Forall (Pure m)) =>
Int -> m a -> m ()
replicateConcurrently_ Int
n =
  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
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Forall (Pure m) => 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

-- | Generalized version of 'A.Concurrently'.
--
-- A value of type @'Concurrently' m a@ is an IO-based operation that can be
-- composed with other 'Concurrently' values, using the 'Applicative' and
-- 'Alternative' instances.
--
-- Calling 'runConcurrently' on a value of type @'Concurrently' m a@ will
-- execute the IO-based lifted operations it contains concurrently, before
-- delivering the result of type 'a'.
--
-- For example
--
-- @
--   (page1, page2, page3) <- 'runConcurrently' $ (,,)
--     '<$>' 'Concurrently' (getURL "url1")
--     '<*>' 'Concurrently' (getURL "url2")
--     '<*>' 'Concurrently' (getURL "url3")
-- @
data Concurrently m a where
  Concurrently
    :: Forall (Pure m) => { forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently :: m a } -> Concurrently m a

-- | Most of the functions in this module have @'Forall' ('Pure' m)@ in their
-- constraints, which means they require the monad 'm' satisfies
-- @'StM' m a ~ a@ for all '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 :: forall a b. (a -> b) -> Concurrently m a -> Concurrently m b
fmap a -> b
f (Concurrently m a
a) = forall (m :: * -> *) a. Forall (Pure m) => m a -> Concurrently m a
Concurrently forall a b. (a -> b) -> a -> b
$ a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
a

instance (MonadBaseControl IO m, Forall (Pure m)) =>
  Applicative (Concurrently m) where
    pure :: forall a. a -> Concurrently m a
pure = forall (m :: * -> *) a. Forall (Pure m) => 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)
fs :: m (a -> b)) <*> :: forall a b.
Concurrently m (a -> b) -> Concurrently m a -> Concurrently m b
<*> Concurrently m a
as =
      forall (m :: * -> *) a. Forall (Pure m) => m a -> Concurrently m a
Concurrently (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
($) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m (a, b)
concurrently m (a -> b)
fs m a
as)
        forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
        forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m (a -> b))

instance (MonadBaseControl IO m, Forall (Pure m)) =>
  Alternative (Concurrently m) where
    empty :: forall a. Concurrently m a
empty = forall (m :: * -> *) a. Forall (Pure m) => m a -> Concurrently m a
Concurrently forall a b. (a -> b) -> a -> b
$ forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
_ -> forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay forall a. Bounded a => a
maxBound
    Concurrently (m a
as :: m a) <|> :: forall a. Concurrently m a -> Concurrently m a -> Concurrently m a
<|> Concurrently m a
bs =
      forall (m :: * -> *) a. Forall (Pure m) => m a -> Concurrently m a
Concurrently (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
<$> forall (m :: * -> *) a b.
(MonadBaseControl IO m, Forall (Pure m)) =>
m a -> m b -> m (Either a b)
race m a
as m a
bs)
        forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p a
inst :: Forall (Pure m) :- Pure m a)
        forall (c :: Constraint) e r. HasDict c e => (c => r) -> e -> r
\\ (forall {k} (p :: k -> Constraint) (a :: k). Forall p :- p 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
    <> :: 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 (MonadBaseControl IO m, Semigroup a, Monoid a, Forall (Pure 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
    mappend :: Concurrently m a -> Concurrently m a -> Concurrently m a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
#else
instance (MonadBaseControl IO m, Monoid a, Forall (Pure m)) =>
  Monoid (Concurrently m a) where
    mempty = pure mempty
    mappend = liftA2 mappend
#endif