Independent.hs

module Control.Concurrent.PooledIO.Independent (
   run,
   runLimited,
   runUnlimited,
   ) where

import Control.Concurrent.PooledIO.Monad (forkFinally, withNumCapabilities)
import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar)
import Control.Exception (evaluate)

import Control.Monad (replicateM_)


{- |
Execute all actions parallelly
but run at most @numCapabilities@ threads at once.
Stop when all actions are finished.
-}
run :: [IO ()] -> IO ()
run = withNumCapabilities runLimited

runLimited :: Int -> [IO ()] -> IO ()
runLimited numCaps acts = do
   let (start, queue) = splitAt numCaps acts
   n <- evaluate $ length start
   mvar <- newEmptyMVar
   mapM_ (forkFinally mvar) start
   mapM_ (\act -> takeMVar mvar >> forkFinally mvar act) queue
   replicateM_ n $ takeMVar mvar

{- |
Execute all actions parallelly without a bound an the number of threads.
Stop when all actions are finished.
-}
runUnlimited :: [IO ()] -> IO ()
runUnlimited acts =
   mapM_ takeMVar =<< mapM fork acts

fork :: IO () -> IO (MVar ())
fork act = do
   mvar <- newEmptyMVar
   forkFinally mvar act
   return mvar