From d44f0b46d78060d36e8171b7278b63b6821a9889 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Oct 2015 19:43:34 -0400 Subject: export lockOutput --- src/Utility/ConcurrentOutput.hs | 12 ++++++++---- 1 file 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 -- cgit v1.2.3