aboutsummaryrefslogtreecommitdiff
path: root/Messages
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-04 16:57:36 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-04 16:58:19 -0400
commitad72bb3ed86ad52aaacf6da6e9563bd34ff6d483 (patch)
tree6a17a4cd9a0df90b80a4667cf5d77e3d04567b36 /Messages
parenteb5ff0cf47a62ef0d617667059267ba772b77cce (diff)
don't display blank regions once done
Diffstat (limited to 'Messages')
-rw-r--r--Messages/Internal.hs21
1 files changed, 12 insertions, 9 deletions
diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 7f114c2c7..168846205 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -18,8 +18,8 @@ import Types.Messages
#ifdef WITH_CONCURRENTOUTPUT
import qualified System.Console.Concurrent as Console
import qualified System.Console.Regions as Regions
-import Data.String
import Control.Concurrent.STM
+import qualified Data.Text as T
#endif
withOutputType :: (OutputType -> Annex a) -> Annex a
@@ -95,16 +95,18 @@ allowConcurrentOutput = id
- the value of the region is displayed in the scrolling area above
- any other active regions.
-
- - When not at a console, a region is not displayed until the end.
+ - When not at a console, a region is not displayed until the action is
+ - complete.
-}
inOwnConsoleRegion :: Annex a -> Annex a
#ifdef WITH_CONCURRENTOUTPUT
-inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
- setregion (Just r)
- a `finally` removeregion r
+inOwnConsoleRegion a = bracket mkregion rmregion go
where
- setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
- removeregion r = do
+ go r = do
+ setregion (Just r)
+ a
+ mkregion = Regions.openConsoleRegion Regions.Linear
+ rmregion r = do
errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
let h = if errflag then Console.StdErr else Console.StdOut
Annex.changeState $ \s ->
@@ -112,9 +114,10 @@ inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
setregion Nothing
liftIO $ atomically $ do
t <- Regions.getConsoleRegion r
+ unless (T.null t) $
+ Console.bufferOutputSTM h t
Regions.closeConsoleRegion r
- Console.bufferOutputSTM h $
- Console.toOutput (t <> fromString "\n")
+ setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
#else
inOwnConsoleRegion = id
#endif