summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 19:43:34 -0400
committerJoey Hess2015-10-28 19:44:31 -0400
commitd44f0b46d78060d36e8171b7278b63b6821a9889 (patch)
tree087d06c3b20db2dbf271c287b322f6c0912d1a1a /src/Utility
parentc85ca96d70f328fb799019a604b7ba82daa0aa33 (diff)
export lockOutput
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/ConcurrentOutput.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs
index 31871977..db0bae0a 100644
--- a/src/Utility/ConcurrentOutput.hs
+++ b/src/Utility/ConcurrentOutput.hs
@@ -8,6 +8,7 @@ module Utility.ConcurrentOutput (
outputConcurrent,
createProcessConcurrent,
waitForProcessConcurrent,
+ lockOutput,
) where
import System.IO
@@ -53,8 +54,11 @@ globalOutputHandle = unsafePerformIO $
getOutputHandle :: IO OutputHandle
getOutputHandle = readMVar globalOutputHandle
--- | Holds a lock while performing an action. Any other threads
--- that try to lockOutput at the same time will block.
+-- | Holds a lock while performing an action that will display output.
+-- While this is running, other threads that try to lockOutput will block,
+-- and calls to `outputConcurrent` and `createProcessConcurrent`
+-- will result in that concurrent output being buffered and not
+-- displayed until the action is done.
lockOutput :: (MonadIO m, MonadMask m) => m a -> m a
lockOutput = bracket_ (liftIO takeOutputLock) (liftIO dropOutputLock)
@@ -253,8 +257,8 @@ outputDrainer ss fromh buf bufsig
-- Wait to lock output, and once we can, display everything
-- that's put into the buffers, until the end.
bufferWriter :: [(Handle, MVar Buffer, TMVar ())] -> IO ()
-bufferWriter l = do
- worker <- async $ void $ lockOutput $ mapConcurrently go l
+bufferWriter ts = do
+ worker <- async $ void $ lockOutput $ mapConcurrently go ts
v <- outputThreads <$> getOutputHandle
atomically $ do
s <- takeTMVar v