summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 12:41:15 -0400
committerJoey Hess2015-10-28 12:41:15 -0400
commit68dbfe1b08c9cf1d976ac84ea53817c54fcd3479 (patch)
tree4ac391f08d91b105caa475608fcff55f2c27b441 /src/Utility
parentf79fe8c0b16638c22a1094b5b2d7e4b62810d839 (diff)
need withConcurrentOutput to flush any buffered concurrent output
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/ConcurrentOutput.hs13
1 files changed, 13 insertions, 0 deletions
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index 1ca92d90..c6550b84 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -1,6 +1,7 @@
-- | Concurrent output handling.
module Utility.ConcurrentOutput (
+ withConcurrentOutput,
outputConcurrent,
createProcessConcurrent,
) where
@@ -113,6 +114,18 @@ updateOutputLocker l = do
putMVar lcker l
modifyMVar_ lcker (const $ return l)
+-- | Use this around any IO actions that use `outputConcurrent`
+-- or `createProcessConcurrent`
+--
+-- 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
+ -- Just taking the output lock is enough to ensure that anything
+ -- that was buffering output has had a chance to flush its buffer.
+ drain = lockOutput (return ())
+
-- | Displays a string to stdout, and flush output so it's displayed.
--
-- Uses locking to ensure that the whole string is output atomically