summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 13:13:38 -0400
committerJoey Hess2015-10-28 13:13:38 -0400
commit6179ad56d9537e0aa972dfa3e60b01b5cfc71c1b (patch)
tree0afe784460153b5cda4b53338e8c7b0c3c307f15
parent873f0861240f33bea00adc629adba80c31b79694 (diff)
propellor spin
-rw-r--r--src/Utility/ConcurrentOutput.hs23
1 files changed, 3 insertions, 20 deletions
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index faef2d00..20e39832 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -74,27 +74,16 @@ takeOutputLock' block = do
lcker <- outputLockedBy <$> getOutputHandle
v' <- tryTakeMVar lcker
case v' of
- Just orig@(ProcessLock h _) -> do
- hPutStrLn stderr $ show ("CHECK STALE")
- hFlush stderr
+ Just orig@(ProcessLock h _) ->
-- if process has exited, lock is stale
ifM (isJust <$> P.getProcessExitCode h)
- ( do
- hPutStrLn stderr $ show ("WAS STALE")
- hFlush stderr
- havelock
+ ( havelock
, if block
then do
- hPutStrLn stderr $ show ("WAIT FOR PROCESS")
- hFlush stderr
void $ P.waitForProcess h
havelock
else do
- hPutStrLn stderr $ show ("RESTORE")
- hFlush stderr
putMVar lcker orig
- hPutStrLn stderr $ show ("RESTORE DONE")
- hFlush stderr
return False
)
Just GeneralLock -> do
@@ -126,11 +115,7 @@ updateOutputLocker :: Locker -> IO ()
updateOutputLocker l = do
lcker <- outputLockedBy <$> getOutputHandle
void $ tryTakeMVar lcker
- hPutStrLn stderr $ show ("SETTING LOCKER")
- hFlush stderr
putMVar lcker l
- hPutStrLn stderr $ show ("SETTING LOCKER DONE")
- hFlush stderr
-- | Use this around any IO actions that use `outputConcurrent`
-- or `createProcessConcurrent`
@@ -176,9 +161,7 @@ outputConcurrent s = do
-- as the output lock becomes free.
createProcessConcurrent :: P.CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, P.ProcessHandle)
createProcessConcurrent p
- | willoutput (P.std_out p) || willoutput (P.std_err p) = do
- hPutStrLn stderr $ show ("CHECK CONCURRENT", cmd)
- hFlush stderr
+ | willoutput (P.std_out p) || willoutput (P.std_err p) =
ifM tryTakeOutputLock
( do
hPutStrLn stderr $ show ("NOT CONCURRENT", cmd)