avoid using concurrent-output at all when --quiet or --json
Of course, it wasn't used much in those modes, because normal output is avoided. But it was still initialized and used in a few places, including a call to hideRegionsWhile.
This commit is contained in:
parent
05bfce7ca8
commit
872af2b2f1
3 changed files with 12 additions and 8 deletions
|
@ -181,11 +181,13 @@ allowConcurrentOutput a = do
|
|||
c <- liftIO getNumCapabilities
|
||||
when (n > c) $
|
||||
liftIO $ setNumCapabilities n
|
||||
ifM (liftIO concurrentOutputSupported)
|
||||
withMessageState $ \s -> case outputType s of
|
||||
NormalOutput -> ifM (liftIO concurrentOutputSupported)
|
||||
( Regions.displayConsoleRegions $
|
||||
goconcurrent' True
|
||||
, goconcurrent' False
|
||||
)
|
||||
_ -> goconcurrent' False
|
||||
goconcurrent' b = bracket_ (setup b) cleanup a
|
||||
setup = setconcurrentoutputenabled
|
||||
cleanup = do
|
||||
|
|
|
@ -270,4 +270,4 @@ prompt a = go =<< Annex.getState Annex.concurrency
|
|||
bracketIO
|
||||
(takeMVar l)
|
||||
(putMVar l)
|
||||
(const $ hideRegionsWhile a)
|
||||
(const $ hideRegionsWhile s a)
|
||||
|
|
|
@ -123,9 +123,11 @@ concurrentOutputSupported = return True -- Windows is always unicode
|
|||
- This needs a new enough version of concurrent-output; otherwise
|
||||
- the regions will not be hidden, but the action still runs, garbling the
|
||||
- display. -}
|
||||
hideRegionsWhile :: Annex a -> Annex a
|
||||
hideRegionsWhile :: MessageState -> Annex a -> Annex a
|
||||
#if MIN_VERSION_concurrent_output(1,9,0)
|
||||
hideRegionsWhile a = bracketIO setup cleanup go
|
||||
hideRegionsWhile s a
|
||||
| concurrentOutputEnabled s = bracketIO setup cleanup go
|
||||
| otherwise = a
|
||||
where
|
||||
setup = Regions.waitDisplayChange $ swapTMVar Regions.regionList []
|
||||
cleanup = void . atomically . swapTMVar Regions.regionList
|
||||
|
|
Loading…
Reference in a new issue