summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 20:10:11 -0400
committerJoey Hess2015-10-28 20:10:11 -0400
commit86a115aaa0c216e4c46e57a324b58177c8b78435 (patch)
tree8a08d9efae9dc7d1c5645e44bdb1f0e9b068628d /src/Utility
parent94011a4a9ee951e2b4c36de7c1d87cb1276766b1 (diff)
have to flush concurrent output before printing result when chaining
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/ConcurrentOutput.hs30
1 files changed, 17 insertions, 13 deletions
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index db0bae0a..3f28068a 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -5,6 +5,7 @@
module Utility.ConcurrentOutput (
withConcurrentOutput,
+ flushConcurrentOutput,
outputConcurrent,
createProcessConcurrent,
waitForProcessConcurrent,
@@ -105,19 +106,22 @@ dropOutputLock = withLock $ void . takeTMVar
-- This is necessary to ensure that buffered concurrent output actually
-- gets displayed before the program exits.
withConcurrentOutput :: IO a -> IO a
-withConcurrentOutput a = a `finally` drain
- where
- -- Wait for all outputThreads to finish. Then, take the output lock
- -- to ensure that nothing is currently generating output, and flush
- -- any buffered output.
- drain = do
- v <- outputThreads <$> getOutputHandle
- atomically $ do
- r <- takeTMVar v
- if r == S.empty
- then return ()
- else retry
- lockOutput $ return ()
+withConcurrentOutput a = a `finally` flushConcurrentOutput
+
+-- | Blocks until any processes started by `createProcessConcurrent` have
+-- finished, and any buffered output is displayed.
+flushConcurrentOutput :: IO ()
+flushConcurrentOutput = do
+ -- Wait for all outputThreads to finish.
+ v <- outputThreads <$> getOutputHandle
+ atomically $ do
+ r <- takeTMVar v
+ if r == S.empty
+ then return ()
+ else retry
+ -- Take output lock to ensure that nothing else is currently
+ -- generating output, and flush any buffered output.
+ lockOutput $ return ()
-- | Displays a string to stdout, and flush output so it's displayed.
--