{-# 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 :: m a -> m (Async (StM m a))
async = (IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
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))
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 :: m a -> m (Async (StM m a))
asyncBound = (IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
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))
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 :: Int -> m a -> m (Async (StM m a))
asyncOn Int
cpu = (IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing (Int -> IO (StM m a) -> IO (Async (StM m a))
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 b. m b -> m b) -> m a) -> m (Async (StM m a))
asyncWithUnmask (forall b. m b -> m b) -> m a
actionWith =
  (IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
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))
forall a. IO a -> IO (Async a)
A.async ((forall b. m b -> m b) -> m a
actionWith ((IO (StM m b) -> IO (StM m b)) -> m b -> m b
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m b) -> IO (StM m b)
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 :: 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 =
  (IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
(IO (StM m a) -> IO (Async (StM m a)))
-> m a -> m (Async (StM m a))
asyncUsing (Int -> IO (StM m a) -> IO (Async (StM m a))
forall a. Int -> IO a -> IO (Async a)
A.asyncOn Int
cpu) ((forall b. m b -> m b) -> m a
actionWith ((IO (StM m b) -> IO (StM m b)) -> m b -> m b
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m b) -> IO (StM m b)
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 :: (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 =
  (RunInBase m IO -> IO (Async (StM m a))) -> m (Async (StM m a))
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m IO -> IO (Async (StM m a))) -> m (Async (StM m a)))
-> (RunInBase m IO -> IO (Async (StM m a))) -> m (Async (StM m a))
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
runInIO -> IO (StM m a) -> IO (Async (StM m a))
fork (m a -> IO (StM m a)
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 :: m a -> (Async (StM m a) -> m b) -> m b
withAsync = (m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
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))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async
{-# INLINABLE withAsync #-}

-- | Generalized version of 'A.withAsyncBound'.
withAsyncBound
  :: MonadBaseControl IO m
  => m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncBound :: m a -> (Async (StM m a) -> m b) -> m b
withAsyncBound = (m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
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))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
asyncBound
{-# INLINABLE withAsyncBound #-}

-- | Generalized version of 'A.withAsyncOn'.
withAsyncOn
  :: MonadBaseControl IO m
  => Int
  -> m a
  -> (Async (StM m a) -> m b)
  -> m b
withAsyncOn :: Int -> m a -> (Async (StM m a) -> m b) -> m b
withAsyncOn = (m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
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)))
 -> m a -> (Async (StM m a) -> m b) -> m b)
-> (Int -> m a -> m (Async (StM m a)))
-> Int
-> m a
-> (Async (StM m a) -> m b)
-> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> m a -> m (Async (StM m a))
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 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 =
  (m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
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))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async ((forall c. m c -> m c) -> m a
actionWith ((IO (StM m c) -> IO (StM m c)) -> m c -> m c
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m c) -> IO (StM m c)
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 :: 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 =
  (m a -> m (Async (StM m a)))
-> m a -> (Async (StM m a) -> m b) -> m b
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 (Int -> m a -> m (Async (StM m a))
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 ((IO (StM m c) -> IO (StM m c)) -> m c -> m c
forall (b :: * -> *) (m :: * -> *) a c.
MonadBaseControl b m =>
(b (StM m a) -> b (StM m c)) -> m a -> m c
liftBaseOp_ IO (StM m c) -> IO (StM m c)
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 :: (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 a. m a -> m a) -> m b) -> m b
forall (m :: * -> *) b.
MonadBaseControl IO m =>
((forall a. m a -> m a) -> m b) -> m b
E.mask (((forall a. m a -> m a) -> m b) -> m b)
-> ((forall a. m a -> m a) -> m b) -> m b
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 (m a -> m (Async (StM m a))) -> m a -> m (Async (StM m a))
forall a b. (a -> b) -> a -> b
$ m a -> m a
forall a. m a -> m a
restore m a
action
  b
r <- m b -> m b
forall a. m a -> m a
restore (Async (StM m a) -> m b
inner Async (StM m a)
a) m b -> (SomeException -> m b) -> m b
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \SomeException
e -> do
    Async (StM m a) -> m ()
forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async (StM m a)
a
    SomeException -> m b
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
E.throwIO (SomeException
e :: SomeException)
  Async (StM m a) -> m ()
forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async (StM m a)
a
  b -> m b
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 :: Async (StM m a) -> m a
wait = IO (StM m a) -> m (StM m a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (StM m a) -> m (StM m a))
-> (Async (StM m a) -> IO (StM m a))
-> Async (StM m a)
-> m (StM m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async (StM m a) -> IO (StM m a)
forall a. Async a -> IO a
A.wait (Async (StM m a) -> m (StM m a))
-> (StM m a -> m a) -> Async (StM m a) -> m a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> StM m a -> m a
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 :: Async (StM m a) -> m (Maybe (Either SomeException a))
poll Async (StM m a)
a =
  IO (Maybe (Either SomeException (StM m a)))
-> m (Maybe (Either SomeException (StM m a)))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a) -> IO (Maybe (Either SomeException (StM m a)))
forall a. Async a -> IO (Maybe (Either SomeException a))
A.poll Async (StM m a)
a) m (Maybe (Either SomeException (StM m a)))
-> (Maybe (Either SomeException (StM m a))
    -> m (Maybe (Either SomeException a)))
-> m (Maybe (Either SomeException a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  m (Maybe (Either SomeException a))
-> (Either SomeException (StM m a)
    -> m (Maybe (Either SomeException a)))
-> Maybe (Either SomeException (StM m a))
-> m (Maybe (Either SomeException a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Either SomeException a)
-> m (Maybe (Either SomeException a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Either SomeException a)
forall a. Maybe a
Nothing) ((Either SomeException a -> Maybe (Either SomeException a))
-> m (Either SomeException a) -> m (Maybe (Either SomeException a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException a -> Maybe (Either SomeException a)
forall a. a -> Maybe a
Just (m (Either SomeException a) -> m (Maybe (Either SomeException a)))
-> (Either SomeException (StM m a) -> m (Either SomeException a))
-> Either SomeException (StM m a)
-> m (Maybe (Either SomeException a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (StM m a) -> m (Either SomeException a)
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 :: Async a -> m ()
cancel = IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> (Async a -> IO ()) -> Async a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> IO ()
forall a. Async a -> IO ()
A.cancel

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

-- | Generalized version of 'A.uninterruptibleCancel'.
uninterruptibleCancel :: MonadBase IO m => Async a -> m ()
uninterruptibleCancel :: Async a -> m ()
uninterruptibleCancel = IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> (Async a -> IO ()) -> Async a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> IO ()
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 :: Async (StM m a) -> m (Either SomeException a)
waitCatch Async (StM m a)
a = IO (Either SomeException (StM m a))
-> m (Either SomeException (StM m a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a) -> IO (Either SomeException (StM m a))
forall a. Async a -> IO (Either SomeException a)
A.waitCatch Async (StM m a)
a) m (Either SomeException (StM m a))
-> (Either SomeException (StM m a) -> m (Either SomeException a))
-> m (Either SomeException a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either SomeException (StM m a) -> m (Either SomeException a)
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 :: [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) <- IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a))
-> IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a)
forall a b. (a -> b) -> a -> b
$ [Async (StM m a)] -> IO (Async (StM m a), StM m a)
forall a. [Async a] -> IO (Async a, a)
A.waitAny [Async (StM m a)]
as
  a
r <- StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
s
  (Async (StM m a), a) -> m (Async (StM m a), a)
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 :: [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) <- IO (Async (StM m a), Either SomeException (StM m a))
-> m (Async (StM m a), Either SomeException (StM m a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Async (StM m a), Either SomeException (StM m a))
 -> m (Async (StM m a), Either SomeException (StM m a)))
-> IO (Async (StM m a), Either SomeException (StM m a))
-> m (Async (StM m a), Either SomeException (StM m a))
forall a b. (a -> b) -> a -> b
$ [Async (StM m a)]
-> IO (Async (StM m a), Either SomeException (StM m a))
forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatch [Async (StM m a)]
as
  Either SomeException a
r <- Either SomeException (StM m a) -> m (Either SomeException a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither Either SomeException (StM m a)
s
  (Async (StM m a), Either SomeException a)
-> m (Async (StM m a), Either SomeException a)
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 :: [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) <- IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a))
-> IO (Async (StM m a), StM m a) -> m (Async (StM m a), StM m a)
forall a b. (a -> b) -> a -> b
$ [Async (StM m a)] -> IO (Async (StM m a), StM m a)
forall a. [Async a] -> IO (Async a, a)
A.waitAnyCancel [Async (StM m a)]
as
  a
r <- StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
s
  (Async (StM m a), a) -> m (Async (StM m a), a)
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 :: [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) <- IO (Async (StM m a), Either SomeException (StM m a))
-> m (Async (StM m a), Either SomeException (StM m a))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO (Async (StM m a), Either SomeException (StM m a))
 -> m (Async (StM m a), Either SomeException (StM m a)))
-> IO (Async (StM m a), Either SomeException (StM m a))
-> m (Async (StM m a), Either SomeException (StM m a))
forall a b. (a -> b) -> a -> b
$ [Async (StM m a)]
-> IO (Async (StM m a), Either SomeException (StM m a))
forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatchCancel [Async (StM m a)]
as
  Either SomeException a
r <- Either SomeException (StM m a) -> m (Either SomeException a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither Either SomeException (StM m a)
s
  (Async (StM m a), Either SomeException a)
-> m (Async (StM m a), Either SomeException a)
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 :: Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEither Async (StM m a)
a Async (StM m b)
b =
  IO (Either (StM m a) (StM m b)) -> m (Either (StM m a) (StM m b))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a)
-> Async (StM m b) -> IO (Either (StM m a) (StM m b))
forall a b. Async a -> Async b -> IO (Either a b)
A.waitEither Async (StM m a)
a Async (StM m b)
b) m (Either (StM m a) (StM m b))
-> (Either (StM m a) (StM m b) -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (StM m a -> m (Either a b))
-> (StM m b -> m (Either a b))
-> Either (StM m a) (StM m b)
-> m (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left (m a -> m (Either a b))
-> (StM m a -> m a) -> StM m a -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM) ((b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right (m b -> m (Either a b))
-> (StM m b -> m b) -> StM m b -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m b -> m b
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 :: 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 =
  IO
  (Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b)))
-> m (Either
        (Either SomeException (StM m a)) (Either SomeException (StM m b)))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a)
-> Async (StM m b)
-> IO
     (Either
        (Either SomeException (StM m a)) (Either SomeException (StM m b)))
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) m (Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b)))
-> (Either
      (Either SomeException (StM m a)) (Either SomeException (StM m b))
    -> m (Either (Either SomeException a) (Either SomeException b)))
-> m (Either (Either SomeException a) (Either SomeException b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (Either SomeException (StM m a)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m b)
    -> m (Either (Either SomeException a) (Either SomeException b)))
-> Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b))
-> m (Either (Either SomeException a) (Either SomeException b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Either SomeException a
 -> Either (Either SomeException a) (Either SomeException b))
-> m (Either SomeException a)
-> m (Either (Either SomeException a) (Either SomeException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException a
-> Either (Either SomeException a) (Either SomeException b)
forall a b. a -> Either a b
Left (m (Either SomeException a)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m a) -> m (Either SomeException a))
-> Either SomeException (StM m a)
-> m (Either (Either SomeException a) (Either SomeException b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (StM m a) -> m (Either SomeException a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither) ((Either SomeException b
 -> Either (Either SomeException a) (Either SomeException b))
-> m (Either SomeException b)
-> m (Either (Either SomeException a) (Either SomeException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException b
-> Either (Either SomeException a) (Either SomeException b)
forall a b. b -> Either a b
Right (m (Either SomeException b)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m b) -> m (Either SomeException b))
-> Either SomeException (StM m b)
-> m (Either (Either SomeException a) (Either SomeException b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (StM m b) -> m (Either SomeException b)
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 :: Async (StM m a) -> Async (StM m b) -> m (Either a b)
waitEitherCancel Async (StM m a)
a Async (StM m b)
b =
  IO (Either (StM m a) (StM m b)) -> m (Either (StM m a) (StM m b))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a)
-> Async (StM m b) -> IO (Either (StM m a) (StM m b))
forall a b. Async a -> Async b -> IO (Either a b)
A.waitEitherCancel Async (StM m a)
a Async (StM m b)
b) m (Either (StM m a) (StM m b))
-> (Either (StM m a) (StM m b) -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (StM m a -> m (Either a b))
-> (StM m b -> m (Either a b))
-> Either (StM m a) (StM m b)
-> m (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a b) -> m a -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either a b
forall a b. a -> Either a b
Left (m a -> m (Either a b))
-> (StM m a -> m a) -> StM m a -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM) ((b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either a b
forall a b. b -> Either a b
Right (m b -> m (Either a b))
-> (StM m b -> m b) -> StM m b -> m (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m b -> m b
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 :: 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 =
  IO
  (Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b)))
-> m (Either
        (Either SomeException (StM m a)) (Either SomeException (StM m b)))
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a)
-> Async (StM m b)
-> IO
     (Either
        (Either SomeException (StM m a)) (Either SomeException (StM m b)))
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) m (Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b)))
-> (Either
      (Either SomeException (StM m a)) (Either SomeException (StM m b))
    -> m (Either (Either SomeException a) (Either SomeException b)))
-> m (Either (Either SomeException a) (Either SomeException b))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  (Either SomeException (StM m a)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m b)
    -> m (Either (Either SomeException a) (Either SomeException b)))
-> Either
     (Either SomeException (StM m a)) (Either SomeException (StM m b))
-> m (Either (Either SomeException a) (Either SomeException b))
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((Either SomeException a
 -> Either (Either SomeException a) (Either SomeException b))
-> m (Either SomeException a)
-> m (Either (Either SomeException a) (Either SomeException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException a
-> Either (Either SomeException a) (Either SomeException b)
forall a b. a -> Either a b
Left (m (Either SomeException a)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m a) -> m (Either SomeException a))
-> Either SomeException (StM m a)
-> m (Either (Either SomeException a) (Either SomeException b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (StM m a) -> m (Either SomeException a)
forall (m :: * -> *) e a.
MonadBaseControl IO m =>
Either e (StM m a) -> m (Either e a)
sequenceEither) ((Either SomeException b
 -> Either (Either SomeException a) (Either SomeException b))
-> m (Either SomeException b)
-> m (Either (Either SomeException a) (Either SomeException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either SomeException b
-> Either (Either SomeException a) (Either SomeException b)
forall a b. b -> Either a b
Right (m (Either SomeException b)
 -> m (Either (Either SomeException a) (Either SomeException b)))
-> (Either SomeException (StM m b) -> m (Either SomeException b))
-> Either SomeException (StM m b)
-> m (Either (Either SomeException a) (Either SomeException b))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either SomeException (StM m b) -> m (Either SomeException b)
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_ :: Async a -> Async b -> m ()
waitEither_ Async a
a Async b
b = IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async a -> Async b -> IO ()
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 :: 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) <- IO (StM m a, StM m b) -> m (StM m a, StM m b)
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (Async (StM m a) -> Async (StM m b) -> IO (StM m a, StM m b)
forall a b. Async a -> Async b -> IO (a, b)
A.waitBoth Async (StM m a)
a Async (StM m b)
b)
  a
ra <- StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m a
sa
  b
rb <- StM m b -> m b
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM StM m b
sb
  (a, b) -> m (a, b)
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 :: Async a -> m ()
link = IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> (Async a -> IO ()) -> Async a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> IO ()
forall a. Async a -> IO ()
A.link

-- | Generalized version of 'A.link2'.
link2 :: MonadBase IO m => Async a -> Async b -> m ()
link2 :: Async a -> Async b -> m ()
link2 = (IO () -> m ()
forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase (IO () -> m ()) -> (Async b -> IO ()) -> Async b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Async b -> IO ()) -> Async b -> m ())
-> (Async a -> Async b -> IO ()) -> Async a -> Async b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> Async b -> IO ()
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 :: m a -> m b -> m (Either a b)
race m a
left m b
right =
  m a -> (Async (StM m a) -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left ((Async (StM m a) -> m (Either a b)) -> m (Either a b))
-> (Async (StM m a) -> m (Either a b)) -> m (Either a b)
forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  m b -> (Async (StM m b) -> m (Either a b)) -> m (Either a b)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right ((Async (StM m b) -> m (Either a b)) -> m (Either a b))
-> (Async (StM m b) -> m (Either a b)) -> m (Either a b)
forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  Async (StM m a) -> Async (StM m b) -> m (Either a 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_ :: m a -> m b -> m ()
race_ m a
left m b
right =
  m a -> (Async (StM m a) -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left ((Async (StM m a) -> m ()) -> m ())
-> (Async (StM m a) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  m b -> (Async (StM m b) -> m ()) -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right ((Async (StM m b) -> m ()) -> m ())
-> (Async (StM m b) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  Async (StM m a) -> Async (StM m b) -> m ()
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 :: m a -> m b -> m (a, b)
concurrently m a
left m b
right =
  m a -> (Async (StM m a) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m a
left ((Async (StM m a) -> m (a, b)) -> m (a, b))
-> (Async (StM m a) -> m (a, b)) -> m (a, b)
forall a b. (a -> b) -> a -> b
$ \Async (StM m a)
a ->
  m b -> (Async (StM m b) -> m (a, b)) -> m (a, b)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> (Async (StM m a) -> m b) -> m b
withAsync m b
right ((Async (StM m b) -> m (a, b)) -> m (a, b))
-> (Async (StM m b) -> m (a, b)) -> m (a, b)
forall a b. (a -> b) -> a -> b
$ \Async (StM m b)
b ->
  Async (StM m a) -> Async (StM m b) -> m (a, 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_ :: m a -> m b -> m ()
concurrently_ m a
left m b
right = m (a, b) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (a, b) -> m ()) -> m (a, b) -> m ()
forall a b. (a -> b) -> a -> b
$ m a -> m b -> m (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 :: (a -> m b) -> t a -> m (t b)
mapConcurrently a -> m b
f = Concurrently m (t b) -> m (t b)
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently (Concurrently m (t b) -> m (t b))
-> (t a -> Concurrently m (t b)) -> t a -> m (t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Concurrently m b) -> t a -> Concurrently m (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (m b -> Concurrently m b
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m b -> Concurrently m b) -> (a -> m b) -> a -> Concurrently m b
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_ :: (a -> m b) -> t a -> m ()
mapConcurrently_ a -> m b
f = Concurrently m () -> m ()
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently (Concurrently m () -> m ())
-> (t a -> Concurrently m ()) -> t a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Concurrently m ()) -> t a -> Concurrently m ()
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (m () -> Concurrently m ()
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m () -> Concurrently m ())
-> (a -> m ()) -> a -> Concurrently m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m b -> m ()) -> (a -> m b) -> a -> m ()
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 :: t a -> (a -> m b) -> m (t b)
forConcurrently = ((a -> m b) -> t a -> m (t b)) -> t a -> (a -> m b) -> m (t b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> t a -> m (t b)
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_ :: t a -> (a -> m b) -> m ()
forConcurrently_ = ((a -> m b) -> t a -> m ()) -> t a -> (a -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m b) -> t a -> m ()
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 :: Int -> m a -> m [a]
replicateConcurrently Int
n =
  Concurrently m [a] -> m [a]
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently (Concurrently m [a] -> m [a])
-> (m a -> Concurrently m [a]) -> m a -> m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Concurrently m a] -> Concurrently m [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ([Concurrently m a] -> Concurrently m [a])
-> (m a -> [Concurrently m a]) -> m a -> Concurrently m [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Concurrently m a -> [Concurrently m a]
forall a. Int -> a -> [a]
replicate Int
n (Concurrently m a -> [Concurrently m a])
-> (m a -> Concurrently m a) -> m a -> [Concurrently m a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Concurrently m a
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently

-- | Generalized version of 'A.replicateConcurrently_'.
replicateConcurrently_
  :: MonadBaseControl IO m
  => Int
  -> m a
  -> m ()
replicateConcurrently_ :: Int -> m a -> m ()
replicateConcurrently_ Int
n =
  Concurrently m () -> m ()
forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently (Concurrently m () -> m ())
-> (m a -> Concurrently m ()) -> m a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Concurrently m ()] -> Concurrently m ()
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Concurrently m ()] -> Concurrently m ())
-> (m a -> [Concurrently m ()]) -> m a -> Concurrently m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Concurrently m () -> [Concurrently m ()]
forall a. Int -> a -> [a]
replicate Int
n (Concurrently m () -> [Concurrently m ()])
-> (m a -> Concurrently m ()) -> m a -> [Concurrently m ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> Concurrently m ()
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m () -> Concurrently m ())
-> (m a -> m ()) -> m a -> Concurrently m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> m ()
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 { Concurrently m a -> m a
runConcurrently :: m a }

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

instance MonadBaseControl IO m => Applicative (Concurrently m) where
  pure :: a -> Concurrently m a
pure = m a -> Concurrently m a
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m a -> Concurrently m a) -> (a -> m a) -> a -> Concurrently m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Concurrently m (a -> b)
fs <*> :: Concurrently m (a -> b) -> Concurrently m a -> Concurrently m b
<*> Concurrently m a
as =
    m b -> Concurrently m b
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m b -> Concurrently m b) -> m b -> Concurrently m b
forall a b. (a -> b) -> a -> b
$ ((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($) ((a -> b, a) -> b) -> m (a -> b, a) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> b) -> m a -> m (a -> b, a)
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 :: Concurrently m a
empty = m a -> Concurrently m a
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m a -> Concurrently m a) -> m a -> Concurrently m a
forall a b. (a -> b) -> a -> b
$ (RunInBase m IO -> IO a) -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
(RunInBase m b -> b a) -> m a
liftBaseWith ((RunInBase m IO -> IO a) -> m a)
-> (RunInBase m IO -> IO a) -> m a
forall a b. (a -> b) -> a -> b
$ \RunInBase m IO
_ -> IO () -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO a) -> IO () -> IO a
forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
forall a. Bounded a => a
maxBound
  Concurrently m a
as <|> :: Concurrently m a -> Concurrently m a -> Concurrently m a
<|> Concurrently m a
bs =
    m a -> Concurrently m a
forall (m :: * -> *) a. m a -> Concurrently m a
Concurrently (m a -> Concurrently m a) -> m a -> Concurrently m a
forall a b. (a -> b) -> a -> b
$ (a -> a) -> (a -> a) -> Either a a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id (Either a a -> a) -> m (Either a a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m a -> m (Either a a)
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
(<>) = (a -> a -> a)
-> 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 a -> a -> a
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 = a -> Concurrently m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
    mappend :: Concurrently m a -> Concurrently m a -> Concurrently m a
mappend = Concurrently m a -> Concurrently m a -> Concurrently m a
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 :: Either e (StM m a) -> m (Either e a)
sequenceEither = (e -> m (Either e a))
-> (StM m a -> m (Either e a))
-> Either e (StM m a)
-> m (Either e a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a))
-> (e -> Either e a) -> e -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> Either e a
forall a b. a -> Either a b
Left) ((a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either e a
forall a b. b -> Either a b
Right (m a -> m (Either e a))
-> (StM m a -> m a) -> StM m a -> m (Either e a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StM m a -> m a
forall (b :: * -> *) (m :: * -> *) a.
MonadBaseControl b m =>
StM m a -> m a
restoreM)