cabal-cache-1.1.0.2: src/HaskellWorks/CabalCache/Concurrent/Fork.hs

module HaskellWorks.CabalCache.Concurrent.Fork
  ( forkThreadsWait,
  ) where

import Control.Exception (finally)
import HaskellWorks.Prelude

import qualified Control.Concurrent     as IO
import qualified Control.Concurrent.STM as STM

forkThreadsWait :: Int -> IO () -> IO ()
forkThreadsWait n f = do
  tDone <- STM.atomically $ STM.newTVar (0 :: Int)
  forM_ [1 .. n] $ \_ -> IO.forkIO do
    f `finally` (STM.atomically $ STM.modifyTVar tDone (+1))

  STM.atomically do
    done <- STM.readTVar tDone
    when (done < n) STM.retry