BoundedThreadGroup.hs

{-| This module wraps Control.Concurrent.Thread.Group and provides a bounded 
    version of ThreadGroup, mainly 'BoundedThreadGroup'.
    
    In addition to the functionality of 'ThreadGroup', 'BoundedThreadGroup'
    will block creation of threads until there fewer than the given 
    max size.
-}
{-# LANGUAGE RecordWildCards, RankNTypes #-}
module Control.Concurrent.Thread.BoundedThreadGroup where
import Control.Concurrent.Thread.Group (ThreadGroup)
import qualified Control.Concurrent.Thread as Thread
import qualified Control.Concurrent.Thread.Group as ThreadGroup
import Control.Concurrent
import Control.Concurrent.STM

-- | A 'BoundedThreadGroup' extends the concept of a 'ThreadGroup' by
--   restricting the number of active threads to a given max size.
--   If one attempts to create more than the max size number of threads
--   the fork function will block until threads finish.
data BoundedThreadGroup = BoundedThreadGroup 
    { maxSize     :: Int
    , threadGroup :: ThreadGroup
    }

-- | Create a new 'BoundedThreadGroup' with the passed in max size
new :: Int -> IO BoundedThreadGroup
new maxSize = do 
  threadGroup <- ThreadGroup.new 
  return BoundedThreadGroup {..}

-- | Same as Control.Concurrent.Thread.Group.nrOfRunning
nrOfRunning :: BoundedThreadGroup -> STM Int
nrOfRunning BoundedThreadGroup {..} = ThreadGroup.nrOfRunning threadGroup

-- | Same as Control.Concurrent.Thread.Group.wait
wait :: BoundedThreadGroup -> IO ()
wait BoundedThreadGroup {..} = ThreadGroup.wait threadGroup

-- | Same as Control.Concurrent.Thread.Group.waitN
waitN :: Int -> BoundedThreadGroup -> IO ()
waitN i BoundedThreadGroup {..} = ThreadGroup.waitN i threadGroup

-- | Same as Control.Concurrent.Thread.Group.forkIO but waits there are less
--   then the max size number of threads.
forkIO :: BoundedThreadGroup -> IO a -> IO (ThreadId, IO (Thread.Result a))
forkIO BoundedThreadGroup {..} action = do
  ThreadGroup.waitN maxSize threadGroup
  ThreadGroup.forkIO threadGroup action 

-- | Same as Control.Concurrent.Thread.Group.forkOS but waits there are less
--   then the max size number of threads.
forkOS :: BoundedThreadGroup -> IO a -> IO (ThreadId, IO (Thread.Result a))
forkOS BoundedThreadGroup {..} action = do
  ThreadGroup.waitN maxSize threadGroup
  ThreadGroup.forkOS threadGroup action 

-- | Same as Control.Concurrent.Thread.Group.forkOn but waits there are less
--   then the max size number of threads.
forkOn :: Int 
       -> BoundedThreadGroup 
       -> IO a 
       -> IO (ThreadId, IO (Thread.Result a))
forkOn i BoundedThreadGroup {..} action = do
  ThreadGroup.waitN maxSize threadGroup
  ThreadGroup.forkOn i threadGroup action

-- | Same as Control.Concurrent.Thread.Group.forkIOWithUnmask 
--   but waits there are less then the max size number of threads.
forkIOWithUnmask :: BoundedThreadGroup
                 -> ((forall b. IO b -> IO b) -> IO a)
                 -> IO (ThreadId, IO (Thread.Result a))
forkIOWithUnmask BoundedThreadGroup {..} f = do 
  ThreadGroup.waitN maxSize threadGroup
  ThreadGroup.forkIOWithUnmask threadGroup f

-- | Same as Control.Concurrent.Thread.Group.forkOnWithUnmask 
--   but waits there are less then the max size number of threads.
forkOnWithUnmask :: Int 
                 -> BoundedThreadGroup 
                 -> ((forall b. IO b -> IO b) -> IO a) 
                 -> IO (ThreadId, IO (Thread.Result a))
forkOnWithUnmask i BoundedThreadGroup {..} f = do 
  ThreadGroup.waitN maxSize threadGroup
  ThreadGroup.forkOnWithUnmask i threadGroup f