diff options
Diffstat (limited to 'src/Utility')
| -rw-r--r-- | src/Utility/ConcurrentOutput.hs | 23 |
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) |