WorkGroup.hs

module WorkGroup where

import Control.Monad (replicateM_)
import Control.Concurrent
import Control.Concurrent.QSem
import Control.Concurrent.MVar

-- | A WorkGroup is a manager for creating threads. When you create threads
-- using forkIOwg, you can wait for all them to exit using joinWorkGroup.
-- It's implemented because haskell doesn't have joinThread function.
data WorkGroup = WorkGroup {
      wgNum :: MVar Int
    , wgSem :: QSem
    }

newWorkGroup :: IO WorkGroup
newWorkGroup = do
  num <- newMVar 0
  sem <- newQSem 0
  return WorkGroup { wgNum=num, wgSem=sem }

-- | forkIO in workgroup. WorkGroup will keep track of started threads and
-- master thread can wait for all of them via joinWorkGroup wg.
forkIOwg :: WorkGroup -> IO () -> IO ThreadId
forkIOwg wg action = do
  modifyMVar_ (wgNum wg) (\n -> return $ n + 1)
  forkFinally action (\e -> signalQSem $ wgSem wg)

joinWorkGroup :: WorkGroup -> IO ()
joinWorkGroup wg = do
  n <- readMVar (wgNum wg)
  replicateM_ n $ waitQSem $ wgSem wg