{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
Module      : Control.Concurrent.Async.Lifted
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 wrapped version of @Control.Concurrent.Async@ with types generalized
from 'IO' to all monads in either 'MonadBase' or 'MonadBaseControl'.

All the functions restore the monadic effects in the forked computation
unless specified otherwise.

If your monad stack satisfies @'StM' m a ~ a@ (e.g. the reader monad), consider
using @Control.Concurrent.Async.Lifted.Safe@ module, which prevents you from
messing up monadic effects.
-}

module Control.Concurrent.Async.Lifted
  ( -- * Asynchronous actions
    A.Async
    -- ** 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
  , link, 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 ((>=>), forever, void)
import Data.Foldable (fold)
import GHC.IO (unsafeUnmask)
import Prelude

import Control.Concurrent.Async (Async)
import Control.Exception.Lifted (SomeException, Exception)
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Trans.Control
import qualified Control.Concurrent.Async as A
import qualified Control.Exception.Lifted as E

#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 :: MonadBaseControl IO m => m a -> m (Async (StM m a))
async :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async = forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing forall a. IO a -> IO (Async a)
A.async

-- | Generalized version of 'A.asyncBound'.
asyncBound :: MonadBaseControl IO m => m a -> m (Async (StM m a))
asyncBound :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
asyncBound = forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing forall a. IO a -> IO (Async a)
A.asyncBound

-- | Generalized version of 'A.asyncOn'.
asyncOn :: MonadBaseControl IO m => Int -> m a -> m (Async (StM m a))
asyncOn :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Async (StM m a))
asyncOn Int
cpu = forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing (forall a. Int -> IO a -> IO (Async a)
A.asyncOn Int
cpu)

-- | Generalized version of 'A.asyncWithUnmask'.
asyncWithUnmask
  :: MonadBaseControl IO m
  => ((forall b. m b -> m b) -> m a)
  -> m (Async (StM m a))
asyncWithUnmask :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
((forall b. m b -> m b) -> m a) -> m (Async (StM m a))
asyncWithUnmask (forall b. m b -> m b) -> m a
actionWith =
  forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing forall a. IO a -> IO (Async a)
A.async ((forall b. m b -> m b) -> m a
actionWith (forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unsafeUnmask))

-- | Generalized version of 'A.asyncOnWithUnmask'.
asyncOnWithUnmask
  :: MonadBaseControl IO m
  => Int
  -> ((forall b. m b -> m b) -> m a)
  -> m (Async (StM m a))
asyncOnWithUnmask :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> ((forall b. m b -> m b) -> m a) -> m (Async (StM m a))
asyncOnWithUnmask Int
cpu (forall b. m b -> m b) -> m a
actionWith =
  forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing (forall a. Int -> IO a -> IO (Async a)
A.asyncOn Int
cpu) ((forall b. m b -> m b) -> m a
actionWith (forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unsafeUnmask))

asyncUsing
  :: MonadBaseControl IO m
  => (IO (StM m a) -> IO (Async (StM m a)))
  -> m a
  -> m (Async (StM m a))
asyncUsing :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing IO (StM m a) -> IO (Async (StM m a))
fork m a
m =
  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
runInIO -> IO (StM m a) -> IO (Async (StM m a))
fork (RunInBase m IO
runInIO m a
m)

-- | Generalized version of 'A.withAsync'.
withAsync
  :: MonadBaseControl IO m
  => m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsync :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b))
-> m a -> (Async (StM m a) -> m b) -> m b
liftWithAsync forall a b. IO a -> (Async a -> IO b) -> IO b
A.withAsync
{-# INLINABLE withAsync #-}

-- | Generalized version of 'A.withAsyncBound'.
withAsyncBound
  :: MonadBaseControl IO m
  => m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncBound :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsyncBound = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b))
-> m a -> (Async (StM m a) -> m b) -> m b
liftWithAsync forall a b. IO a -> (Async a -> IO b) -> IO b
A.withAsyncBound
{-# INLINABLE withAsyncBound #-}

liftWithAsync
  :: MonadBaseControl IO m
  => (IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b))
  -> (m a -> (Async (StM m a) -> m b) -> m b)
liftWithAsync :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b))
-> m a -> (Async (StM m a) -> m b) -> m b
liftWithAsync IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b)
withA m a
action Async (StM m a) -> m b
cont = forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< do
  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
runInIO -> do
    IO (StM m a) -> (Async (StM m a) -> IO (StM m b)) -> IO (StM m b)
withA (RunInBase m IO
runInIO m a
action) (RunInBase m IO
runInIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m a) -> m b
cont)

-- | Generalized version of 'A.withAsyncOn'.
withAsyncOn
  :: MonadBaseControl IO m
  => Int
  -> m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncOn :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Int -> m a -> (Async (StM m a) -> m b) -> m b
withAsyncOn = forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
withAsyncUsing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Async (StM m a))
asyncOn
{-# INLINABLE withAsyncOn #-}

-- | Generalized version of 'A.withAsyncWithUnmask'.
withAsyncWithUnmask
  :: MonadBaseControl IO m
  => ((forall c. m c -> m c) -> m a)
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncWithUnmask :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
((forall c. m c -> m c) -> m a) -> (Async (StM m a) -> m b) -> m b
withAsyncWithUnmask (forall c. m c -> m c) -> m a
actionWith =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
withAsyncUsing forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async ((forall c. m c -> m c) -> m a
actionWith (forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unsafeUnmask))
{-# INLINABLE withAsyncWithUnmask #-}

-- | Generalized version of 'A.withAsyncOnWithUnmask'.
withAsyncOnWithUnmask
  :: MonadBaseControl IO m
  => Int
  -> ((forall c. m c -> m c) -> m a)
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncOnWithUnmask :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Int
-> ((forall c. m c -> m c) -> m a)
-> (Async (StM m a) -> m b)
-> m b
withAsyncOnWithUnmask Int
cpu (forall c. m c -> m c) -> m a
actionWith =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
withAsyncUsing (forall (m :: * -> *) a.
MonadBaseControl IO m =>
Int -> m a -> m (Async (StM m a))
asyncOn Int
cpu) ((forall c. m c -> m c) -> m a
actionWith (forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ forall a. IO a -> IO a
unsafeUnmask))
{-# INLINABLE withAsyncOnWithUnmask #-}

withAsyncUsing
  :: MonadBaseControl IO m
  => (m a -> m (Async (StM m a)))
  -> m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncUsing :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
(m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
withAsyncUsing m a -> m (Async (StM m a))
fork m a
action Async (StM m a) -> m b
inner = forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
E.mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
restore -> do
  Async (StM m a)
a <- m a -> m (Async (StM m a))
fork forall a b. (a -> b) -> a -> b
$ forall a. m a -> m a
restore m a
action
  b
r <- forall a. m a -> m a
restore (Async (StM m a) -> m b
inner Async (StM m a)
a) forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \SomeException
e -> do
    forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async (StM m a)
a
    forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
E.throwIO (SomeException
e :: SomeException)
  forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async (StM m a)
a
  forall (m :: * -> *) a. Monad m => a -> m a
return b
r

-- | Generalized version of 'A.wait'.
wait :: MonadBaseControl IO m => Async (StM m a) -> m a
wait :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m 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 (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM

-- | Generalized version of 'A.poll'.
poll
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> m (Maybe (Either SomeException a))
poll :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m (Maybe (Either SomeException a))
poll Async (StM m a)
a =
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a. Async a -> IO (Maybe (Either SomeException a))
A.poll Async (StM m a)
a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither)

-- | Generalized version of 'A.cancel'.
cancel :: MonadBase IO m => Async a -> m ()
cancel :: forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel = 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.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 (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 e a. Exception e => Async a -> e -> IO ()
A.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 (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO ()
A.uninterruptibleCancel

-- | Generalized version of 'A.waitCatch'.
waitCatch
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> m (Either SomeException a)
waitCatch :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m (Either SomeException a)
waitCatch Async (StM m a)
a = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a. Async a -> IO (Either SomeException a)
A.waitCatch Async (StM m a)
a) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither

-- | Generalized version of 'A.waitAny'.
waitAny :: MonadBaseControl IO m => [Async (StM m a)] -> m (Async (StM m a), a)
waitAny :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
[Async (StM m a)] -> m (Async (StM m a), a)
waitAny [Async (StM m a)]
as = do
  (Async (StM m a)
a, StM m a
s) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. [Async a] -> IO (Async a, a)
A.waitAny [Async (StM m a)]
as
  a
r <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (Async (StM m a)
a, a
r)

-- | Generalized version of 'A.waitAnyCatch'.
waitAnyCatch
  :: MonadBaseControl IO m
  => [Async (StM m a)]
  -> m (Async (StM m a), Either SomeException a)
waitAnyCatch :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
[Async (StM m a)] -> m (Async (StM m a), Either SomeException a)
waitAnyCatch [Async (StM m a)]
as = do
  (Async (StM m a)
a, Either SomeException (StM m a)
s) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatch [Async (StM m a)]
as
  Either SomeException a
r <- forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither Either SomeException (StM m a)
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (Async (StM m a)
a, Either SomeException a
r)

-- | Generalized version of 'A.waitAnyCancel'.
waitAnyCancel
  :: MonadBaseControl IO m
  => [Async (StM m a)]
  -> m (Async (StM m a), a)
waitAnyCancel :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
[Async (StM m a)] -> m (Async (StM m a), a)
waitAnyCancel [Async (StM m a)]
as = do
  (Async (StM m a)
a, StM m a
s) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. [Async a] -> IO (Async a, a)
A.waitAnyCancel [Async (StM m a)]
as
  a
r <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (Async (StM m a)
a, a
r)

-- | Generalized version of 'A.waitAnyCatchCancel'.
waitAnyCatchCancel
  :: MonadBaseControl IO m
  => [Async (StM m a)]
  -> m (Async (StM m a), Either SomeException a)
waitAnyCatchCancel :: forall (m :: * -> *) a.
MonadBaseControl IO m =>
[Async (StM m a)] -> m (Async (StM m a), Either SomeException a)
waitAnyCatchCancel [Async (StM m a)]
as = do
  (Async (StM m a)
a, Either SomeException (StM m a)
s) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase forall a b. (a -> b) -> a -> b
$ forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatchCancel [Async (StM m a)]
as
  Either SomeException a
r <- forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither Either SomeException (StM m a)
s
  forall (m :: * -> *) a. Monad m => a -> m a
return (Async (StM m a)
a, Either SomeException a
r)

-- | Generalized version of 'A.waitEither'.
waitEither
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> Async (StM m b)
  -> m (Either a b)
waitEither :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEither Async (StM m a)
a Async (StM m b)
b =
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b. Async a -> Async b -> IO (Either a b)
A.waitEither Async (StM m a)
a Async (StM m b)
b) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)

-- | Generalized version of 'A.waitEitherCatch'.
waitEitherCatch
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> Async (StM m b)
  -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a)
-> Async (StM m b)
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async (StM m a)
a Async (StM m b)
b =
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatch Async (StM m a)
a Async (StM m b)
b) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither)

-- | Generalized version of 'A.waitEitherCancel'.
waitEitherCancel
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> Async (StM m b)
  -> m (Either a b)
waitEitherCancel :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEitherCancel Async (StM m a)
a Async (StM m b)
b =
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b. Async a -> Async b -> IO (Either a b)
A.waitEitherCancel Async (StM m a)
a Async (StM m b)
b) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)

-- | Generalized version of 'A.waitEitherCatchCancel'.
waitEitherCatchCancel
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> Async (StM m b)
  -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a)
-> Async (StM m b)
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel Async (StM m a)
a Async (StM m b)
b =
  forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatch Async (StM m a)
a Async (StM m b)
b) 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither)

-- | Generalized version of 'A.waitEither_'.
--
-- NOTE: This function discards the monadic effects besides IO in the forked
-- computation.
waitEither_
  :: MonadBase IO m
  => Async a
  -> Async b
  -> m ()
waitEither_ :: forall (m :: * -> *) a b.
MonadBase IO m =>
Async a -> Async b -> m ()
waitEither_ Async a
a Async b
b = forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b. Async a -> Async b -> IO ()
A.waitEither_ Async a
a Async b
b)

-- | Generalized version of 'A.waitBoth'.
waitBoth
  :: MonadBaseControl IO m
  => Async (StM m a)
  -> Async (StM m b)
  -> m (a, b)
waitBoth :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (a, b)
waitBoth Async (StM m a)
a Async (StM m b)
b = do
  (StM m a
sa, StM m b
sb) <- forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (forall a b. Async a -> Async b -> IO (a, b)
A.waitBoth Async (StM m a)
a Async (StM m b)
b)
  a
ra <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
sa
  b
rb <- forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m b
sb
  forall (m :: * -> *) a. Monad m => a -> m a
return (a
ra, b
rb)
{-# INLINABLE waitBoth #-}

-- | Generalized version of 'A.link'.
link :: MonadBase IO m => Async a -> m ()
link :: forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
link = 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.link

-- | Generalized version of 'A.link2'.
link2 :: MonadBase IO m => Async a -> Async b -> m ()
link2 :: forall (m :: * -> *) a b.
MonadBase IO m =>
Async a -> Async b -> m ()
link2 = (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.link2

-- | Generalized version of 'A.race'.
race :: MonadBaseControl IO m => m a -> m b -> m (Either a b)
race :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m (Either a b)
race m a
left m b
right =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEither Async (StM m a)
a Async (StM m b)
b
{-# INLINABLE race #-}

-- | Generalized version of 'A.race_'.
--
-- NOTE: This function discards the monadic effects besides IO in the forked
-- computation.
race_ :: MonadBaseControl IO m => m a -> m b -> m ()
race_ :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
race_ m a
left m b
right =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  forall (m :: * -> *) a b.
MonadBase IO m =>
Async a -> Async b -> m ()
waitEither_ Async (StM m a)
a Async (StM m b)
b
{-# INLINABLE race_ #-}

-- | Generalized version of 'A.concurrently'.
concurrently :: MonadBaseControl IO m => m a -> m b -> m (a, b)
concurrently :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m (a, b)
concurrently m a
left m b
right =
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Async (StM m a) -> Async (StM m b) -> m (a, b)
waitBoth Async (StM m a)
a Async (StM m b)
b
{-# INLINABLE concurrently #-}

-- | Generalized version of 'A.concurrently_'.
concurrently_ :: MonadBaseControl IO m => m a -> m b -> m ()
concurrently_ :: forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
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.
MonadBaseControl IO m =>
m a -> m b -> m (a, b)
concurrently m a
left m b
right
{-# INLINABLE concurrently_ #-}

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

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

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

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

-- | Generalized version of 'A.replicateConcurrently_'.
replicateConcurrently_
  :: MonadBaseControl IO m
  => Int
  -> m a
  -> m ()
replicateConcurrently_ :: forall (m :: * -> *) a. MonadBaseControl IO 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. 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")
-- @
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
a) = forall (m :: * -> *) a. 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 => 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)
fs <*> :: 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
$ 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 =>
m a -> m b -> m (a, b)
concurrently m (a -> b)
fs m a
as

instance MonadBaseControl IO 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 (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 <|> :: 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
<$> forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m (Either a b)
race m a
as m a
bs

#if MIN_VERSION_base(4, 9, 0)
instance (MonadBaseControl IO m, Semigroup a) =>
  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) =>
  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) => Monoid (Concurrently m a) where
  mempty = pure mempty
  mappend = liftA2 mappend
#endif

sequenceEither :: MonadBaseControl IO m => Either e (StM m a) -> m (Either e a)
sequenceEither :: forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)