summaryrefslogtreecommitdiff
path: root/src/System
diff options
context:
space:
mode:
authorJoey Hess2015-11-01 17:13:56 -0400
committerJoey Hess2015-11-01 17:13:56 -0400
commit0d721d5c34f98a7ea8fe3a44a883100d2d6f27a3 (patch)
tree79b5568b921420aa8a97f5712404552f4457e039 /src/System
parent29704bff62d8995a1649115b04adf844bdd0a7a0 (diff)
propellor spin
Diffstat (limited to 'src/System')
-rw-r--r--src/System/Console/Concurrent/Internal.hs18
1 files changed, 5 insertions, 13 deletions
diff --git a/src/System/Console/Concurrent/Internal.hs b/src/System/Console/Concurrent/Internal.hs
index ef308f7d..55290921 100644
--- a/src/System/Console/Concurrent/Internal.hs
+++ b/src/System/Console/Concurrent/Internal.hs
@@ -179,32 +179,24 @@ waitForProcessConcurrent :: ConcurrentProcessHandle -> IO ExitCode
waitForProcessConcurrent (ConcurrentProcessHandle h) = checkexit
where
checkexit = maybe waitsome return =<< P.getProcessExitCode h
- waitsome = maybe checkexit return =<< bracket lock unlock go
+ waitsome = maybe checkexit return =<< bracket_ lock unlock go
+ lock = atomically $ putTMVar lck ()
+ unlock = atomically $ takeTMVar lck
lck = waitForProcessLock globalOutputHandle
- lock = atomically $ tryPutTMVar lck ()
- unlock True = atomically $ takeTMVar lck
- unlock False = return ()
- go True = do
+ go = do
let v = processWaiters globalOutputHandle
l <- atomically $ readTMVar v
if null l
-- Avoid waitAny [] which blocks forever;
then Just <$> P.waitForProcess h
else do
- -- Wait for any of the running
+ -- Wait for the first of all the running
-- processes to exit. It may or may not
-- be the one corresponding to the
-- ProcessHandle. If it is,
-- getProcessExitCode will succeed.
void $ tryIO $ waitAny l
return Nothing
- go False = do
- -- Another thread took the lck first. Wait for that thread to
- -- wait for one of the running processes to exit.
- atomically $ do
- putTMVar lck ()
- takeTMVar lck
- return Nothing
-- Registers an action that waits for a process to exit,
-- adding it to the processWaiters list, and removing it once the action