{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
module UnliftIO.Internals.Async where
import Control.Applicative
import Control.Concurrent (threadDelay, getNumCapabilities)
import qualified Control.Concurrent as C
import Control.Concurrent.Async (Async)
import qualified Control.Concurrent.Async as A
import Control.Concurrent.STM
import Control.Exception (Exception, SomeException)
import Control.Monad (forever, liftM, unless, void, (>=>))
import Control.Monad.IO.Unlift
import Data.Foldable (for_, traverse_)
import Data.Typeable (Typeable)
import Data.IORef (IORef, readIORef, atomicWriteIORef, newIORef, atomicModifyIORef')
import qualified UnliftIO.Exception as UE
import qualified Control.Exception as E
import GHC.Generics (Generic)
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup
#else
import Data.Monoid hiding (Alt)
#endif
import Data.Foldable (Foldable, toList)
import Data.Traversable (Traversable, for, traverse)
async :: MonadUnliftIO m => m a -> m (Async a)
async :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async m a
m = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. IO a -> IO (Async a)
A.async forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
m
asyncBound :: MonadUnliftIO m => m a -> m (Async a)
asyncBound :: forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
asyncBound m a
m = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. IO a -> IO (Async a)
A.asyncBound forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
m
asyncOn :: MonadUnliftIO m => Int -> m a -> m (Async a)
asyncOn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Async a)
asyncOn Int
i m a
m = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. Int -> IO a -> IO (Async a)
A.asyncOn Int
i forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m a
m
asyncWithUnmask :: MonadUnliftIO m => ((forall b. m b -> m b) -> m a) -> m (Async a)
asyncWithUnmask :: forall (m :: * -> *) a.
MonadUnliftIO m =>
((forall b. m b -> m b) -> m a) -> m (Async a)
asyncWithUnmask (forall b. m b -> m b) -> m a
m =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
A.asyncWithUnmask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
unmask -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall b. m b -> m b) -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> IO b
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run
asyncOnWithUnmask :: MonadUnliftIO m => Int -> ((forall b. m b -> m b) -> m a) -> m (Async a)
asyncOnWithUnmask :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> ((forall b. m b -> m b) -> m a) -> m (Async a)
asyncOnWithUnmask Int
i (forall b. m b -> m b) -> m a
m =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. Int -> ((forall b. IO b -> IO b) -> IO a) -> IO (Async a)
A.asyncOnWithUnmask Int
i forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
unmask -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall b. m b -> m b) -> m a
m forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> IO b
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run
withAsync :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b
withAsync :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsync m a
a Async a -> m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> (Async a -> IO b) -> IO b
A.withAsync (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> m b
b)
withAsyncBound :: MonadUnliftIO m => m a -> (Async a -> m b) -> m b
withAsyncBound :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> (Async a -> m b) -> m b
withAsyncBound m a
a Async a -> m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> (Async a -> IO b) -> IO b
A.withAsyncBound (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> m b
b)
withAsyncOn :: MonadUnliftIO m => Int -> m a -> (Async a -> m b) -> m b
withAsyncOn :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Int -> m a -> (Async a -> m b) -> m b
withAsyncOn Int
i m a
a Async a -> m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. Int -> IO a -> (Async a -> IO b) -> IO b
A.withAsyncOn Int
i (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> m b
b)
withAsyncWithUnmask
:: MonadUnliftIO m
=> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncWithUnmask :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
((forall c. m c -> m c) -> m a) -> (Async a -> m b) -> m b
withAsyncWithUnmask (forall c. m c -> m c) -> m a
a Async a -> m b
b =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b.
((forall b. IO b -> IO b) -> IO a) -> (Async a -> IO b) -> IO b
A.withAsyncWithUnmask
(\forall b. IO b -> IO b
unmask -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall c. m c -> m c) -> m a
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> IO b
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run)
(forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> m b
b)
withAsyncOnWithUnmask
:: MonadUnliftIO m
=> Int
-> ((forall c. m c -> m c) -> m a)
-> (Async a -> m b)
-> m b
withAsyncOnWithUnmask :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
Int -> ((forall c. m c -> m c) -> m a) -> (Async a -> m b) -> m b
withAsyncOnWithUnmask Int
i (forall c. m c -> m c) -> m a
a Async a -> m b
b =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b.
Int
-> ((forall b. IO b -> IO b) -> IO a) -> (Async a -> IO b) -> IO b
A.withAsyncOnWithUnmask Int
i
(\forall b. IO b -> IO b
unmask -> forall a. m a -> IO a
run forall a b. (a -> b) -> a -> b
$ (forall c. m c -> m c) -> m a
a forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. IO b -> IO b
unmask forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run)
(forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Async a -> m b
b)
wait :: MonadIO m => Async a -> m a
wait :: forall (m :: * -> *) a. MonadIO m => Async a -> m a
wait = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO a
A.wait
poll :: MonadIO m => Async a -> m (Maybe (Either SomeException a))
poll :: forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Maybe (Either SomeException a))
poll = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO (Maybe (Either SomeException a))
A.poll
waitCatch :: MonadIO m => Async a -> m (Either SomeException a)
waitCatch :: forall (m :: * -> *) a.
MonadIO m =>
Async a -> m (Either SomeException a)
waitCatch = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO (Either SomeException a)
A.waitCatch
cancel :: MonadIO m => Async a -> m ()
cancel :: forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO ()
A.cancel
uninterruptibleCancel :: MonadIO m => Async a -> m ()
uninterruptibleCancel :: forall (m :: * -> *) a. MonadIO m => Async a -> m ()
uninterruptibleCancel = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO ()
A.uninterruptibleCancel
cancelWith :: (Exception e, MonadIO m) => Async a -> e -> m ()
cancelWith :: forall e (m :: * -> *) a.
(Exception e, MonadIO m) =>
Async a -> e -> m ()
cancelWith Async a
a e
e = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall e a. Exception e => Async a -> e -> IO ()
A.cancelWith Async a
a (forall e. Exception e => e -> SomeException
UE.toAsyncException e
e))
waitAny :: MonadIO m => [Async a] -> m (Async a, a)
waitAny :: forall (m :: * -> *) a. MonadIO m => [Async a] -> m (Async a, a)
waitAny = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, a)
A.waitAny
waitAnyCatch :: MonadIO m => [Async a] -> m (Async a, Either SomeException a)
waitAnyCatch :: forall (m :: * -> *) a.
MonadIO m =>
[Async a] -> m (Async a, Either SomeException a)
waitAnyCatch = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatch
waitAnyCancel :: MonadIO m => [Async a] -> m (Async a, a)
waitAnyCancel :: forall (m :: * -> *) a. MonadIO m => [Async a] -> m (Async a, a)
waitAnyCancel = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, a)
A.waitAnyCancel
waitAnyCatchCancel :: MonadIO m => [Async a] -> m (Async a, Either SomeException a)
waitAnyCatchCancel :: forall (m :: * -> *) a.
MonadIO m =>
[Async a] -> m (Async a, Either SomeException a)
waitAnyCatchCancel = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Async a] -> IO (Async a, Either SomeException a)
A.waitAnyCatchCancel
waitEither :: MonadIO m => Async a -> Async b -> m (Either a b)
waitEither :: forall (m :: * -> *) a b.
MonadIO m =>
Async a -> Async b -> m (Either a b)
waitEither Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO (Either a b)
A.waitEither Async a
a Async b
b)
waitEitherCatch :: MonadIO m => Async a -> Async b -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch :: forall (m :: * -> *) a b.
MonadIO m =>
Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatch Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatch Async a
a Async b
b)
waitEitherCancel :: MonadIO m => Async a -> Async b -> m (Either a b)
waitEitherCancel :: forall (m :: * -> *) a b.
MonadIO m =>
Async a -> Async b -> m (Either a b)
waitEitherCancel Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO (Either a b)
A.waitEitherCancel Async a
a Async b
b)
waitEitherCatchCancel :: MonadIO m => Async a -> Async b -> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel :: forall (m :: * -> *) a b.
MonadIO m =>
Async a
-> Async b
-> m (Either (Either SomeException a) (Either SomeException b))
waitEitherCatchCancel Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b.
Async a
-> Async b
-> IO (Either (Either SomeException a) (Either SomeException b))
A.waitEitherCatchCancel Async a
a Async b
b)
waitEither_ :: MonadIO m => Async a -> Async b -> m ()
waitEither_ :: forall (m :: * -> *) a b. MonadIO m => Async a -> Async b -> m ()
waitEither_ Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO ()
A.waitEither_ Async a
a Async b
b)
waitBoth :: MonadIO m => Async a -> Async b -> m (a, b)
waitBoth :: forall (m :: * -> *) a b.
MonadIO m =>
Async a -> Async b -> m (a, b)
waitBoth Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO (a, b)
A.waitBoth Async a
a Async b
b)
link :: MonadIO m => Async a -> m ()
link :: forall (m :: * -> *) a. MonadIO m => Async a -> m ()
link = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO ()
A.link
link2 :: MonadIO m => Async a -> Async b -> m ()
link2 :: forall (m :: * -> *) a b. MonadIO m => Async a -> Async b -> m ()
link2 Async a
a Async b
b = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall a b. Async a -> Async b -> IO ()
A.link2 Async a
a Async b
b)
race :: MonadUnliftIO m => m a -> m b -> m (Either a b)
race :: forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race m a
a m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> IO b -> IO (Either a b)
A.race (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run m b
b)
race_ :: MonadUnliftIO m => m a -> m b -> m ()
race_ :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
race_ m a
a m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> IO b -> IO ()
A.race_ (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run m b
b)
concurrently :: MonadUnliftIO m => m a -> m b -> m (a, b)
concurrently :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m (a, b)
concurrently m a
a m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> IO b -> IO (a, b)
A.concurrently (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run m b
b)
concurrently_ :: MonadUnliftIO m => m a -> m b -> m ()
concurrently_ :: forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m ()
concurrently_ m a
a m b
b = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a b. IO a -> IO b -> IO ()
A.concurrently_ (forall a. m a -> IO a
run m a
a) (forall a. m a -> IO a
run m b
b)
newtype Concurrently m a = Concurrently
{ forall (m :: * -> *) a. Concurrently m a -> m a
runConcurrently :: m a
}
instance Monad 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
$ forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> b
f m a
a
instance MonadUnliftIO 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 (m :: * -> *) a. Monad m => a -> m a
return
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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (\(a -> b
f, a
a) -> a -> b
f a
a) (forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m (a, b)
concurrently m (a -> b)
fs m a
as)
instance MonadUnliftIO 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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (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 (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id) (forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race m a
as m a
bs)
#if MIN_VERSION_base(4,9,0)
instance (MonadUnliftIO 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 (Semigroup a, Monoid a, MonadUnliftIO 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 (Monoid a, MonadUnliftIO m) => Monoid (Concurrently m a) where
mempty = pure mempty
mappend = liftA2 mappend
#endif
forConcurrently :: MonadUnliftIO m => Traversable t => t a -> (a -> m b) -> m (t b)
forConcurrently :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
t a -> (a -> m b) -> m (t b)
forConcurrently = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently
{-# INLINE forConcurrently #-}
forConcurrently_ :: MonadUnliftIO m => Foldable f => f a -> (a -> m b) -> m ()
forConcurrently_ :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
f a -> (a -> m b) -> m ()
forConcurrently_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
mapConcurrently_
{-# INLINE forConcurrently_ #-}
#if MIN_VERSION_base(4,7,0)
#else
replicateConcurrently :: (Functor m, MonadUnliftIO m) => Int -> m a -> m [a]
#endif
replicateConcurrently :: Int -> f a -> f [a]
replicateConcurrently Int
cnt f a
m =
case forall a. Ord a => a -> a -> Ordering
compare Int
cnt Int
1 of
Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Ordering
EQ -> (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
m
Ordering
GT -> forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently forall a. a -> a
id (forall a. Int -> a -> [a]
replicate Int
cnt f a
m)
{-# INLINE replicateConcurrently #-}
#if MIN_VERSION_base(4,7,0)
replicateConcurrently_ :: (Applicative m, MonadUnliftIO m) => Int -> m a -> m ()
#else
replicateConcurrently_ :: (MonadUnliftIO m) => Int -> m a -> m ()
#endif
replicateConcurrently_ :: forall (m :: * -> *) a.
(Applicative m, MonadUnliftIO m) =>
Int -> m a -> m ()
replicateConcurrently_ Int
cnt m a
m =
case forall a. Ord a => a -> a -> Ordering
compare Int
cnt Int
1 of
Ordering
LT -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Ordering
EQ -> forall (f :: * -> *) a. Functor f => f a -> f ()
void m a
m
Ordering
GT -> forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
mapConcurrently_ forall a. a -> a
id (forall a. Int -> a -> [a]
replicate Int
cnt m a
m)
{-# INLINE replicateConcurrently_ #-}
#if MIN_VERSION_base(4,8,0)
mapConcurrently :: MonadUnliftIO m => Traversable t => (a -> m b) -> t a -> m (t b)
mapConcurrently :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently a -> m b
f t a
t = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. Flat a -> IO a
runFlat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
(forall a. FlatApp a -> Flat a
FlatApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> FlatApp a
FlatAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)
t a
t
{-# INLINE mapConcurrently #-}
mapConcurrently_ :: MonadUnliftIO m => Foldable f => (a -> m b) -> f a -> m ()
mapConcurrently_ :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
mapConcurrently_ a -> m b
f f a
t = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall a. Flat a -> IO a
runFlat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_
(forall a. FlatApp a -> Flat a
FlatApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> FlatApp a
FlatAction forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f)
f a
t
{-# INLINE mapConcurrently_ #-}
data Conc m a where
Action :: m a -> Conc m a
Apply :: Conc m (v -> a) -> Conc m v -> Conc m a
LiftA2 :: (x -> y -> a) -> Conc m x -> Conc m y -> Conc m a
Pure :: a -> Conc m a
Alt :: Conc m a -> Conc m a -> Conc m a
Empty :: Conc m a
deriving instance Functor m => Functor (Conc m)
conc :: m a -> Conc m a
conc :: forall (m :: * -> *) a. m a -> Conc m a
conc = forall (m :: * -> *) a. m a -> Conc m a
Action
{-# INLINE conc #-}
runConc :: MonadUnliftIO m => Conc m a -> m a
runConc :: forall (m :: * -> *) a. MonadUnliftIO m => Conc m a -> m a
runConc = forall (m :: * -> *) a. MonadUnliftIO m => Conc m a -> m (Flat a)
flatten forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Flat a -> IO a
runFlat)
{-# INLINE runConc #-}
instance MonadUnliftIO m => Applicative (Conc m) where
pure :: forall a. a -> Conc m a
pure = forall a (m :: * -> *). a -> Conc m a
Pure
{-# INLINE pure #-}
<*> :: forall a b. Conc m (a -> b) -> Conc m a -> Conc m b
(<*>) = forall (m :: * -> *) v a. Conc m (v -> a) -> Conc m v -> Conc m a
Apply
{-# INLINE (<*>) #-}
#if MIN_VERSION_base(4,11,0)
liftA2 :: forall a b c. (a -> b -> c) -> Conc m a -> Conc m b -> Conc m c
liftA2 = forall v y a (m :: * -> *).
(v -> y -> a) -> Conc m v -> Conc m y -> Conc m a
LiftA2
{-# INLINE liftA2 #-}
#endif
Conc m a
a *> :: forall a b. Conc m a -> Conc m b -> Conc m b
*> Conc m b
b = forall v y a (m :: * -> *).
(v -> y -> a) -> Conc m v -> Conc m y -> Conc m a
LiftA2 (\a
_ b
x -> b
x) Conc m a
a Conc m b
b
{-# INLINE (*>) #-}
instance MonadUnliftIO m => Alternative (Conc m) where
empty :: forall a. Conc m a
empty = forall (m :: * -> *) a. Conc m a
Empty
{-# INLINE empty #-}
<|> :: forall a. Conc m a -> Conc m a -> Conc m a
(<|>) = forall (m :: * -> *) a. Conc m a -> Conc m a -> Conc m a
Alt
{-# INLINE (<|>) #-}
#if MIN_VERSION_base(4, 11, 0)
instance (MonadUnliftIO m, Semigroup a) => Semigroup (Conc m a) where
<> :: Conc m a -> Conc m a -> Conc 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
(<>)
{-# INLINE (<>) #-}
#endif
instance (Monoid a, MonadUnliftIO m) => Monoid (Conc m a) where
mempty :: Conc m a
mempty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty
{-# INLINE mempty #-}
mappend :: Conc m a -> Conc m a -> Conc m a
mappend = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Monoid a => a -> a -> a
mappend
{-# INLINE mappend #-}
data Flat a
= FlatApp !(FlatApp a)
| FlatAlt !(FlatApp a) !(FlatApp a) ![FlatApp a]
deriving instance Functor Flat
instance Applicative Flat where
pure :: forall a. a -> Flat a
pure = forall a. FlatApp a -> Flat a
FlatApp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
<*> :: forall a b. Flat (a -> b) -> Flat a -> Flat b
(<*>) Flat (a -> b)
f Flat a
a = forall a. FlatApp a -> Flat a
FlatApp (forall v y a. (v -> y -> a) -> Flat v -> Flat y -> FlatApp a
FlatLiftA2 forall a. a -> a
id Flat (a -> b)
f Flat a
a)
#if MIN_VERSION_base(4,11,0)
liftA2 :: forall a b c. (a -> b -> c) -> Flat a -> Flat b -> Flat c
liftA2 a -> b -> c
f Flat a
a Flat b
b = forall a. FlatApp a -> Flat a
FlatApp (forall v y a. (v -> y -> a) -> Flat v -> Flat y -> FlatApp a
FlatLiftA2 a -> b -> c
f Flat a
a Flat b
b)
#endif
data FlatApp a where
FlatPure :: a -> FlatApp a
FlatAction :: IO a -> FlatApp a
FlatApply :: Flat (v -> a) -> Flat v -> FlatApp a
FlatLiftA2 :: (x -> y -> a) -> Flat x -> Flat y -> FlatApp a
deriving instance Functor FlatApp
instance Applicative FlatApp where
pure :: forall a. a -> FlatApp a
pure = forall a. a -> FlatApp a
FlatPure
<*> :: forall a b. FlatApp (a -> b) -> FlatApp a -> FlatApp b
(<*>) FlatApp (a -> b)
mf FlatApp a
ma = forall v a. Flat (v -> a) -> Flat v -> FlatApp a
FlatApply (forall a. FlatApp a -> Flat a
FlatApp FlatApp (a -> b)
mf) (forall a. FlatApp a -> Flat a
FlatApp FlatApp a
ma)
#if MIN_VERSION_base(4,11,0)
liftA2 :: forall a b c. (a -> b -> c) -> FlatApp a -> FlatApp b -> FlatApp c
liftA2 a -> b -> c
f FlatApp a
a FlatApp b
b = forall v y a. (v -> y -> a) -> Flat v -> Flat y -> FlatApp a
FlatLiftA2 a -> b -> c
f (forall a. FlatApp a -> Flat a
FlatApp FlatApp a
a) (forall a. FlatApp a -> Flat a
FlatApp FlatApp b
b)
#endif
data ConcException
= EmptyWithNoAlternative
deriving (forall x. Rep ConcException x -> ConcException
forall x. ConcException -> Rep ConcException x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConcException x -> ConcException
$cfrom :: forall x. ConcException -> Rep ConcException x
Generic, Int -> ConcException -> ShowS
[ConcException] -> ShowS
ConcException -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConcException] -> ShowS
$cshowList :: [ConcException] -> ShowS
show :: ConcException -> String
$cshow :: ConcException -> String
showsPrec :: Int -> ConcException -> ShowS
$cshowsPrec :: Int -> ConcException -> ShowS
Show, Typeable, ConcException -> ConcException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConcException -> ConcException -> Bool
$c/= :: ConcException -> ConcException -> Bool
== :: ConcException -> ConcException -> Bool
$c== :: ConcException -> ConcException -> Bool
Eq, Eq ConcException
ConcException -> ConcException -> Bool
ConcException -> ConcException -> Ordering
ConcException -> ConcException -> ConcException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConcException -> ConcException -> ConcException
$cmin :: ConcException -> ConcException -> ConcException
max :: ConcException -> ConcException -> ConcException
$cmax :: ConcException -> ConcException -> ConcException
>= :: ConcException -> ConcException -> Bool
$c>= :: ConcException -> ConcException -> Bool
> :: ConcException -> ConcException -> Bool
$c> :: ConcException -> ConcException -> Bool
<= :: ConcException -> ConcException -> Bool
$c<= :: ConcException -> ConcException -> Bool
< :: ConcException -> ConcException -> Bool
$c< :: ConcException -> ConcException -> Bool
compare :: ConcException -> ConcException -> Ordering
$ccompare :: ConcException -> ConcException -> Ordering
Ord)
instance E.Exception ConcException
type DList a = [a] -> [a]
dlistConcat :: DList a -> DList a -> DList a
dlistConcat :: forall a. DList a -> DList a -> DList a
dlistConcat = forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)
{-# INLINE dlistConcat #-}
dlistCons :: a -> DList a -> DList a
dlistCons :: forall a. a -> DList a -> DList a
dlistCons a
a DList a
as = forall a. a -> [a] -> [a]
dlistSingleton a
a forall a. DList a -> DList a -> DList a
`dlistConcat` DList a
as
{-# INLINE dlistCons #-}
dlistConcatAll :: [DList a] -> DList a
dlistConcatAll :: forall a. [DList a] -> DList a
dlistConcatAll = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) forall a. a -> a
id
{-# INLINE dlistConcatAll #-}
dlistToList :: DList a -> [a]
dlistToList :: forall a. DList a -> [a]
dlistToList = (forall a b. (a -> b) -> a -> b
$ [])
{-# INLINE dlistToList #-}
dlistSingleton :: a -> DList a
dlistSingleton :: forall a. a -> [a] -> [a]
dlistSingleton a
a = (a
aforall a. a -> [a] -> [a]
:)
{-# INLINE dlistSingleton #-}
dlistEmpty :: DList a
dlistEmpty :: forall a. DList a
dlistEmpty = forall a. a -> a
id
{-# INLINE dlistEmpty #-}
flatten :: forall m a. MonadUnliftIO m => Conc m a -> m (Flat a)
flatten :: forall (m :: * -> *) a. MonadUnliftIO m => Conc m a -> m (Flat a)
flatten Conc m a
c0 = forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
let both :: forall k. Conc m k -> IO (Flat k)
both :: forall k. Conc m k -> IO (Flat k)
both Conc m k
Empty = forall e a. Exception e => e -> IO a
E.throwIO ConcException
EmptyWithNoAlternative
both (Action m k
m) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> Flat a
FlatApp forall a b. (a -> b) -> a -> b
$ forall a. IO a -> FlatApp a
FlatAction forall a b. (a -> b) -> a -> b
$ forall a. m a -> IO a
run m k
m
both (Apply Conc m (v -> k)
cf Conc m v
ca) = do
Flat (v -> k)
f <- forall k. Conc m k -> IO (Flat k)
both Conc m (v -> k)
cf
Flat v
a <- forall k. Conc m k -> IO (Flat k)
both Conc m v
ca
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> Flat a
FlatApp forall a b. (a -> b) -> a -> b
$ forall v a. Flat (v -> a) -> Flat v -> FlatApp a
FlatApply Flat (v -> k)
f Flat v
a
both (LiftA2 x -> y -> k
f Conc m x
ca Conc m y
cb) = do
Flat x
a <- forall k. Conc m k -> IO (Flat k)
both Conc m x
ca
Flat y
b <- forall k. Conc m k -> IO (Flat k)
both Conc m y
cb
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> Flat a
FlatApp forall a b. (a -> b) -> a -> b
$ forall v y a. (v -> y -> a) -> Flat v -> Flat y -> FlatApp a
FlatLiftA2 x -> y -> k
f Flat x
a Flat y
b
both (Alt Conc m k
ca Conc m k
cb) = do
DList (FlatApp k)
a <- forall k. Conc m k -> IO (DList (FlatApp k))
alt Conc m k
ca
DList (FlatApp k)
b <- forall k. Conc m k -> IO (DList (FlatApp k))
alt Conc m k
cb
case forall a. DList a -> [a]
dlistToList (DList (FlatApp k)
a forall a. DList a -> DList a -> DList a
`dlistConcat` DList (FlatApp k)
b) of
[] -> forall e a. Exception e => e -> IO a
E.throwIO ConcException
EmptyWithNoAlternative
[FlatApp k
x] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> Flat a
FlatApp FlatApp k
x
FlatApp k
x:FlatApp k
y:[FlatApp k]
z -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> FlatApp a -> [FlatApp a] -> Flat a
FlatAlt FlatApp k
x FlatApp k
y [FlatApp k]
z
both (Pure k
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. FlatApp a -> Flat a
FlatApp forall a b. (a -> b) -> a -> b
$ forall a. a -> FlatApp a
FlatPure k
a
alt :: forall k. Conc m k -> IO (DList (FlatApp k))
alt :: forall k. Conc m k -> IO (DList (FlatApp k))
alt Conc m k
Empty = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. DList a
dlistEmpty
alt (Apply Conc m (v -> k)
cf Conc m v
ca) = do
Flat (v -> k)
f <- forall k. Conc m k -> IO (Flat k)
both Conc m (v -> k)
cf
Flat v
a <- forall k. Conc m k -> IO (Flat k)
both Conc m v
ca
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> [a] -> [a]
dlistSingleton forall a b. (a -> b) -> a -> b
$ forall v a. Flat (v -> a) -> Flat v -> FlatApp a
FlatApply Flat (v -> k)
f Flat v
a)
alt (Alt Conc m k
ca Conc m k
cb) = do
DList (FlatApp k)
a <- forall k. Conc m k -> IO (DList (FlatApp k))
alt Conc m k
ca
DList (FlatApp k)
b <- forall k. Conc m k -> IO (DList (FlatApp k))
alt Conc m k
cb
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ DList (FlatApp k)
a forall a. DList a -> DList a -> DList a
`dlistConcat` DList (FlatApp k)
b
alt (Action m k
m) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> [a] -> [a]
dlistSingleton forall a b. (a -> b) -> a -> b
$ forall a. IO a -> FlatApp a
FlatAction (forall a. m a -> IO a
run m k
m))
alt (LiftA2 x -> y -> k
f Conc m x
ca Conc m y
cb) = do
Flat x
a <- forall k. Conc m k -> IO (Flat k)
both Conc m x
ca
Flat y
b <- forall k. Conc m k -> IO (Flat k)
both Conc m y
cb
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> [a] -> [a]
dlistSingleton forall a b. (a -> b) -> a -> b
$ forall v y a. (v -> y -> a) -> Flat v -> Flat y -> FlatApp a
FlatLiftA2 x -> y -> k
f Flat x
a Flat y
b)
alt (Pure k
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> [a] -> [a]
dlistSingleton forall a b. (a -> b) -> a -> b
$ forall a. a -> FlatApp a
FlatPure k
a)
forall k. Conc m k -> IO (Flat k)
both Conc m a
c0
runFlat :: Flat a -> IO a
runFlat :: forall a. Flat a -> IO a
runFlat (FlatApp (FlatAction IO a
io)) = IO a
io
runFlat (FlatApp (FlatPure a
x)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
runFlat Flat a
f0 = forall b. ((forall b. IO b -> IO b) -> IO b) -> IO b
E.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore -> do
TVar Int
resultCountVar <- forall a. a -> IO (TVar a)
newTVarIO Int
0
let go :: forall a.
TMVar E.SomeException
-> Flat a
-> IO (STM a, DList C.ThreadId)
go :: forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
_excVar (FlatApp (FlatPure a
x)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x, forall a. DList a
dlistEmpty)
go TMVar SomeException
excVar (FlatApp (FlatAction IO a
io)) = do
TMVar a
resVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
ThreadId
tid <- ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
C.forkIOWithUnmask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore1 -> do
Either SomeException a
res <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ forall b. IO b -> IO b
restore1 IO a
io
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
resultCountVar (forall a. Num a => a -> a -> a
+ Int
1)
case Either SomeException a
res of
Left SomeException
e -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar SomeException
excVar SomeException
e
Right a
x -> forall a. TMVar a -> a -> STM ()
putTMVar TMVar a
resVar a
x
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. TMVar a -> STM a
readTMVar TMVar a
resVar, forall a. a -> [a] -> [a]
dlistSingleton ThreadId
tid)
go TMVar SomeException
excVar (FlatApp (FlatApply Flat (v -> a)
cf Flat v
ca)) = do
(STM (v -> a)
f, DList ThreadId
tidsf) <- forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar Flat (v -> a)
cf
(STM v
a, DList ThreadId
tidsa) <- forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar Flat v
ca
forall (f :: * -> *) a. Applicative f => a -> f a
pure (STM (v -> a)
f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM v
a, DList ThreadId
tidsf forall a. DList a -> DList a -> DList a
`dlistConcat` DList ThreadId
tidsa)
go TMVar SomeException
excVar (FlatApp (FlatLiftA2 x -> y -> a
f Flat x
a Flat y
b)) = do
(STM x
a', DList ThreadId
tidsa) <- forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar Flat x
a
(STM y
b', DList ThreadId
tidsb) <- forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar Flat y
b
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 x -> y -> a
f STM x
a' STM y
b', DList ThreadId
tidsa forall a. DList a -> DList a -> DList a
`dlistConcat` DList ThreadId
tidsb)
go TMVar SomeException
excVar0 (FlatAlt FlatApp a
x FlatApp a
y [FlatApp a]
z) = do
TMVar SomeException
excVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
TMVar a
resVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
[(STM a, DList ThreadId)]
pairs <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FlatApp a -> Flat a
FlatApp) (FlatApp a
xforall a. a -> [a] -> [a]
:FlatApp a
yforall a. a -> [a] -> [a]
:[FlatApp a]
z)
let ([STM a]
blockers, [DList ThreadId]
workerTids) = forall a b. [(a, b)] -> ([a], [b])
unzip [(STM a, DList ThreadId)]
pairs
ThreadId
helperTid <- ((forall b. IO b -> IO b) -> IO ()) -> IO ThreadId
C.forkIOWithUnmask forall a b. (a -> b) -> a -> b
$ \forall b. IO b -> IO b
restore1 -> do
Either SomeException (Either SomeException a)
eres <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ forall b. IO b -> IO b
restore1 forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
(\STM a
blocker STM (Either SomeException a)
rest -> (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM a
blocker) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> STM (Either SomeException a)
rest)
(forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TMVar a -> STM a
readTMVar TMVar SomeException
excVar)
[STM a]
blockers
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Int
resultCountVar (forall a. Num a => a -> a -> a
+ Int
1)
case Either SomeException (Either SomeException a)
eres of
Left (SomeException
_ :: E.SomeException) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Right (Left SomeException
e) -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> a -> STM Bool
tryPutTMVar TMVar SomeException
excVar0 SomeException
e
Right (Right a
res) -> forall a. TMVar a -> a -> STM ()
putTMVar TMVar a
resVar a
res
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [DList ThreadId]
workerTids forall a b. (a -> b) -> a -> b
$ \DList ThreadId
tids' ->
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. DList a -> [a]
dlistToList DList ThreadId
tids') forall a b. (a -> b) -> a -> b
$ \ThreadId
workerTid -> ThreadId -> IO ()
C.killThread ThreadId
workerTid
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( forall a. TMVar a -> STM a
readTMVar TMVar a
resVar
, ThreadId
helperTid forall a. a -> DList a -> DList a
`dlistCons` forall a. [DList a] -> DList a
dlistConcatAll [DList ThreadId]
workerTids
)
TMVar SomeException
excVar <- forall a. IO (TMVar a)
newEmptyTMVarIO
(STM a
getRes, DList ThreadId
tids0) <- forall a.
TMVar SomeException -> Flat a -> IO (STM a, DList ThreadId)
go TMVar SomeException
excVar Flat a
f0
let tids :: [ThreadId]
tids = forall a. DList a -> [a]
dlistToList DList ThreadId
tids0
tidCount :: Int
tidCount = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ThreadId]
tids
allDone :: Int -> Bool
allDone Int
count =
if Int
count forall a. Ord a => a -> a -> Bool
> Int
tidCount
then forall a. HasCallStack => String -> a
error (String
"allDone: count ("
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
count
forall a. Semigroup a => a -> a -> a
<> String
") should never be greater than tidCount ("
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
tidCount
forall a. Semigroup a => a -> a -> a
<> String
")")
else Int
count forall a. Eq a => a -> a -> Bool
== Int
tidCount
let autoRetry :: IO a -> IO a
autoRetry IO a
action =
IO a
action forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch`
\BlockedIndefinitelyOnSTM
E.BlockedIndefinitelyOnSTM -> IO a -> IO a
autoRetry IO a
action
Either SomeException (Either SomeException a)
res <- forall e a. Exception e => IO a -> IO (Either e a)
E.try forall a b. (a -> b) -> a -> b
$ forall b. IO b -> IO b
restore forall a b. (a -> b) -> a -> b
$ forall b. IO b -> IO b
autoRetry forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$
(forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. TMVar a -> STM a
readTMVar TMVar SomeException
excVar) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM a
getRes)
Int
count0 <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TVar a -> STM a
readTVar TVar Int
resultCountVar
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
allDone Int
count0) forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ThreadId]
tids forall a b. (a -> b) -> a -> b
$ \ThreadId
tid -> ThreadId -> IO ()
C.killThread ThreadId
tid
forall b. IO b -> IO b
restore forall a b. (a -> b) -> a -> b
$ forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
Int
count <- forall a. TVar a -> STM a
readTVar TVar Int
resultCountVar
Bool -> STM ()
check forall a b. (a -> b) -> a -> b
$ Int -> Bool
allDone Int
count
case Either SomeException (Either SomeException a)
res of
Left SomeException
e -> forall e a. Exception e => e -> IO a
E.throwIO (SomeException
e :: E.SomeException)
Right (Left SomeException
e) -> forall e a. Exception e => e -> IO a
E.throwIO SomeException
e
Right (Right a
x) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# INLINEABLE runFlat #-}
#else
mapConcurrently :: MonadUnliftIO m => Traversable t => (a -> m b) -> t a -> m (t b)
mapConcurrently f t = withRunInIO $ \run -> A.mapConcurrently (run . f) t
{-# INLINE mapConcurrently #-}
mapConcurrently_ :: MonadUnliftIO m => Foldable f => (a -> m b) -> f a -> m ()
mapConcurrently_ f t = withRunInIO $ \run -> A.mapConcurrently_ (run . f) t
{-# INLINE mapConcurrently_ #-}
#endif
pooledMapConcurrentlyN :: (MonadUnliftIO m, Traversable t)
=> Int
-> (a -> m b) -> t a -> m (t b)
pooledMapConcurrentlyN :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> (a -> m b) -> t a -> m (t b)
pooledMapConcurrentlyN Int
numProcs a -> m b
f t a
xs =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO Int
numProcs (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) t a
xs
pooledMapConcurrently :: (MonadUnliftIO m, Traversable t) => (a -> m b) -> t a -> m (t b)
pooledMapConcurrently :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
pooledMapConcurrently a -> m b
f t a
xs = do
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
Int
numProcs <- IO Int
getNumCapabilities
forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO Int
numProcs (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) t a
xs
pooledForConcurrentlyN :: (MonadUnliftIO m, Traversable t)
=> Int
-> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> t a -> (a -> m b) -> m (t b)
pooledForConcurrentlyN Int
numProcs = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> (a -> m b) -> t a -> m (t b)
pooledMapConcurrentlyN Int
numProcs)
pooledForConcurrently :: (MonadUnliftIO m, Traversable t) => t a -> (a -> m b) -> m (t b)
pooledForConcurrently :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
t a -> (a -> m b) -> m (t b)
pooledForConcurrently = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
pooledMapConcurrently
pooledMapConcurrentlyIO :: Traversable t => Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO :: forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO Int
numProcs a -> IO b
f t a
xs =
if (Int
numProcs forall a. Ord a => a -> a -> Bool
< Int
1)
then forall a. HasCallStack => String -> a
error String
"pooledMapconcurrentlyIO: number of threads < 1"
else forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO' Int
numProcs a -> IO b
f t a
xs
pooledConcurrently
:: Int
-> IORef [a]
-> (a -> IO ())
-> IO ()
pooledConcurrently :: forall a. Int -> IORef [a] -> (a -> IO ()) -> IO ()
pooledConcurrently Int
numProcs IORef [a]
jobsVar a -> IO ()
f = do
forall (m :: * -> *) a.
(Applicative m, MonadUnliftIO m) =>
Int -> m a -> m ()
replicateConcurrently_ Int
numProcs forall a b. (a -> b) -> a -> b
$ do
let loop :: IO ()
loop = do
Maybe a
mbJob :: Maybe a <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [a]
jobsVar forall a b. (a -> b) -> a -> b
$ \[a]
x -> case [a]
x of
[] -> ([], forall a. Maybe a
Nothing)
a
var : [a]
vars -> ([a]
vars, forall a. a -> Maybe a
Just a
var)
case Maybe a
mbJob of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
x -> do
a -> IO ()
f a
x
IO ()
loop
in IO ()
loop
pooledMapConcurrentlyIO' ::
Traversable t => Int
-> (a -> IO b)
-> t a
-> IO (t b)
pooledMapConcurrentlyIO' :: forall (t :: * -> *) a b.
Traversable t =>
Int -> (a -> IO b) -> t a -> IO (t b)
pooledMapConcurrentlyIO' Int
numProcs a -> IO b
f t a
xs = do
t (a, IORef b)
jobs :: t (a, IORef b) <-
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for t a
xs (\a
x -> (a
x, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (IORef a)
newIORef (forall a. HasCallStack => String -> a
error String
"pooledMapConcurrentlyIO': empty IORef"))
IORef [(a, IORef b)]
jobsVar :: IORef [(a, IORef b)] <- forall a. a -> IO (IORef a)
newIORef (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (a, IORef b)
jobs)
forall a. Int -> IORef [a] -> (a -> IO ()) -> IO ()
pooledConcurrently Int
numProcs IORef [(a, IORef b)]
jobsVar forall a b. (a -> b) -> a -> b
$ \ (a
x, IORef b
outRef) -> a -> IO b
f a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. IORef a -> a -> IO ()
atomicWriteIORef IORef b
outRef
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for t (a, IORef b)
jobs (\(a
_, IORef b
outputRef) -> forall a. IORef a -> IO a
readIORef IORef b
outputRef)
pooledMapConcurrentlyIO_' ::
Foldable t => Int -> (a -> IO ()) -> t a -> IO ()
pooledMapConcurrentlyIO_' :: forall (t :: * -> *) a.
Foldable t =>
Int -> (a -> IO ()) -> t a -> IO ()
pooledMapConcurrentlyIO_' Int
numProcs a -> IO ()
f t a
jobs = do
IORef [a]
jobsVar :: IORef [a] <- forall a. a -> IO (IORef a)
newIORef (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
jobs)
forall a. Int -> IORef [a] -> (a -> IO ()) -> IO ()
pooledConcurrently Int
numProcs IORef [a]
jobsVar a -> IO ()
f
pooledMapConcurrentlyIO_ :: Foldable t => Int -> (a -> IO b) -> t a -> IO ()
pooledMapConcurrentlyIO_ :: forall (t :: * -> *) a b.
Foldable t =>
Int -> (a -> IO b) -> t a -> IO ()
pooledMapConcurrentlyIO_ Int
numProcs a -> IO b
f t a
xs =
if (Int
numProcs forall a. Ord a => a -> a -> Bool
< Int
1)
then forall a. HasCallStack => String -> a
error String
"pooledMapconcurrentlyIO_: number of threads < 1"
else forall (t :: * -> *) a.
Foldable t =>
Int -> (a -> IO ()) -> t a -> IO ()
pooledMapConcurrentlyIO_' Int
numProcs (\a
x -> a -> IO b
f a
x forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) t a
xs
pooledMapConcurrentlyN_ :: (MonadUnliftIO m, Foldable f)
=> Int
-> (a -> m b) -> f a -> m ()
pooledMapConcurrentlyN_ :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
Int -> (a -> m b) -> f a -> m ()
pooledMapConcurrentlyN_ Int
numProcs a -> m b
f f a
t =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (t :: * -> *) a b.
Foldable t =>
Int -> (a -> IO b) -> t a -> IO ()
pooledMapConcurrentlyIO_ Int
numProcs (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) f a
t
pooledMapConcurrently_ :: (MonadUnliftIO m, Foldable f) => (a -> m b) -> f a -> m ()
pooledMapConcurrently_ :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
pooledMapConcurrently_ a -> m b
f f a
t =
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> do
Int
numProcs <- IO Int
getNumCapabilities
forall (t :: * -> *) a b.
Foldable t =>
Int -> (a -> IO b) -> t a -> IO ()
pooledMapConcurrentlyIO_ Int
numProcs (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m b
f) f a
t
pooledForConcurrently_ :: (MonadUnliftIO m, Foldable f) => f a -> (a -> m b) -> m ()
pooledForConcurrently_ :: forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
f a -> (a -> m b) -> m ()
pooledForConcurrently_ = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
pooledMapConcurrently_
pooledForConcurrentlyN_ :: (MonadUnliftIO m, Foldable t)
=> Int
-> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ :: forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Foldable t) =>
Int -> t a -> (a -> m b) -> m ()
pooledForConcurrentlyN_ Int
numProcs = forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
Int -> (a -> m b) -> f a -> m ()
pooledMapConcurrentlyN_ Int
numProcs)
pooledReplicateConcurrentlyN :: (MonadUnliftIO m)
=> Int
-> Int
-> m a -> m [a]
pooledReplicateConcurrentlyN :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m [a]
pooledReplicateConcurrentlyN Int
numProcs Int
cnt m a
task =
if Int
cnt forall a. Ord a => a -> a -> Bool
< Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
Int -> (a -> m b) -> t a -> m (t b)
pooledMapConcurrentlyN Int
numProcs (\Int
_ -> m a
task) [Int
1..Int
cnt]
pooledReplicateConcurrently :: (MonadUnliftIO m)
=> Int
-> m a -> m [a]
pooledReplicateConcurrently :: forall (m :: * -> *) a. MonadUnliftIO m => Int -> m a -> m [a]
pooledReplicateConcurrently Int
cnt m a
task =
if Int
cnt forall a. Ord a => a -> a -> Bool
< Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return []
else forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
pooledMapConcurrently (\Int
_ -> m a
task) [Int
1..Int
cnt]
pooledReplicateConcurrentlyN_ :: (MonadUnliftIO m)
=> Int
-> Int
-> m a -> m ()
pooledReplicateConcurrentlyN_ :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> Int -> m a -> m ()
pooledReplicateConcurrentlyN_ Int
numProcs Int
cnt m a
task =
if Int
cnt forall a. Ord a => a -> a -> Bool
< Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
Int -> (a -> m b) -> f a -> m ()
pooledMapConcurrentlyN_ Int
numProcs (\Int
_ -> m a
task) [Int
1..Int
cnt]
pooledReplicateConcurrently_ :: (MonadUnliftIO m)
=> Int
-> m a -> m ()
pooledReplicateConcurrently_ :: forall (m :: * -> *) a. MonadUnliftIO m => Int -> m a -> m ()
pooledReplicateConcurrently_ Int
cnt m a
task =
if Int
cnt forall a. Ord a => a -> a -> Bool
< Int
1
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else forall (m :: * -> *) (f :: * -> *) a b.
(MonadUnliftIO m, Foldable f) =>
(a -> m b) -> f a -> m ()
pooledMapConcurrently_ (\Int
_ -> m a
task) [Int
1..Int
cnt]