{-# LANGUAGE Safe #-}
module Control.Concurrent.PooledIO.Independent (
run,
runLimited,
runUnlimited,
runException,
) where
import Control.Concurrent.PooledIO.Monad
(withNumCapabilities, chooseNumCapabilities,
forkFinally, forkTry, takeMVarTry, runTry)
import qualified Control.Concurrent.Split.MVar as MVar
import Control.Exception (evaluate)
import Control.Monad (replicateM_)
run :: [IO ()] -> IO ()
run :: [IO ()] -> IO ()
run = forall a b. (Int -> a -> IO b) -> a -> IO b
withNumCapabilities Int -> [IO ()] -> IO ()
runLimited
runLimited :: Int -> [IO ()] -> IO ()
runLimited :: Int -> [IO ()] -> IO ()
runLimited Int
numCaps [IO ()]
acts = do
let ([IO ()]
start, [IO ()]
queue) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
numCaps [IO ()]
acts
Int
n <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO ()]
start
(In ()
mvarIn, Out ()
mvarOut) <- forall a. IO (In a, Out a)
MVar.newEmpty
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (In () -> IO () -> IO ()
forkFinally In ()
mvarIn) [IO ()]
start
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\IO ()
act -> forall a. Out a -> IO a
MVar.take Out ()
mvarOut forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> In () -> IO () -> IO ()
forkFinally In ()
mvarIn IO ()
act) [IO ()]
queue
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n forall a b. (a -> b) -> a -> b
$ forall a. Out a -> IO a
MVar.take Out ()
mvarOut
runUnlimited :: [IO ()] -> IO ()
runUnlimited :: [IO ()] -> IO ()
runUnlimited [IO ()]
acts =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Out a -> IO a
MVar.take forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM IO () -> IO (Out ())
fork [IO ()]
acts
fork :: IO () -> IO (MVar.Out ())
fork :: IO () -> IO (Out ())
fork IO ()
act = do
(In ()
mvarIn, Out ()
mvarOut) <- forall a. IO (In a, Out a)
MVar.newEmpty
In () -> IO () -> IO ()
forkFinally In ()
mvarIn IO ()
act
forall (m :: * -> *) a. Monad m => a -> m a
return Out ()
mvarOut
runException :: Maybe Int -> [IO ()] -> IO ()
runException :: Maybe Int -> [IO ()] -> IO ()
runException Maybe Int
maybeNumCaps [IO ()]
acts = do
Int
numCaps <- Maybe Int -> IO Int
chooseNumCapabilities Maybe Int
maybeNumCaps
Int -> [IO ()] -> IO ()
runOneBreaksAll Int
numCaps [IO ()]
acts
runOneBreaksAll :: Int -> [IO ()] -> IO ()
runOneBreaksAll :: Int -> [IO ()] -> IO ()
runOneBreaksAll Int
numCaps [IO ()]
acts = do
let ([IO ()]
start, [IO ()]
queue) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
numCaps [IO ()]
acts
Int
n <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [IO ()]
start
(In (ThreadId, Either SomeException ())
mvarIn, Out (ThreadId, Either SomeException ())
mvarOut) <- forall a. IO (In a, Out a)
MVar.newEmpty
forall a. StateT (Set ThreadId) IO a -> IO a
runTry forall a b. (a -> b) -> a -> b
$ do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a.
NFData a =>
In (ThreadId, Either SomeException a)
-> IO a -> StateT (Set ThreadId) IO ()
forkTry In (ThreadId, Either SomeException ())
mvarIn) [IO ()]
start
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\IO ()
act -> forall a.
Out (ThreadId, Either SomeException a)
-> StateT (Set ThreadId) IO a
takeMVarTry Out (ThreadId, Either SomeException ())
mvarOut forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a.
NFData a =>
In (ThreadId, Either SomeException a)
-> IO a -> StateT (Set ThreadId) IO ()
forkTry In (ThreadId, Either SomeException ())
mvarIn IO ()
act) [IO ()]
queue
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
n forall a b. (a -> b) -> a -> b
$ forall a.
Out (ThreadId, Either SomeException a)
-> StateT (Set ThreadId) IO a
takeMVarTry Out (ThreadId, Either SomeException ())
mvarOut