disentangle concurrency and message type

This makes -Jn work with --json and --quiet, where before
setting -Jn disabled those options.

Concurrent json output is currently a mess though since threads output
chunks over top of one-another.

1 files changed, 15 insertions, 18 deletions

diff --git a/Messages/Concurrent.hs b/Messages/Concurrent.hs
index 91b840231..41153d067 100644
--- a/Messages/Concurrent.hs
+++ b/Messages/Concurrent.hs
@@ -31,13 +31,13 @@ import GHC.IO.Encoding
  - When built without concurrent-output support, the fallback action is run
  - instead.
  -}
-concurrentMessage :: OutputType -> Bool -> String -> Annex () -> Annex ()
+concurrentMessage :: MessageState -> Bool -> String -> Annex () -> Annex ()
 #ifdef WITH_CONCURRENTOUTPUT
-concurrentMessage o iserror msg fallback 
-	| concurrentOutputEnabled o =
+concurrentMessage s iserror msg fallback 
+	| concurrentOutputEnabled s =
 		go =<< consoleRegion <$> Annex.getState Annex.output
 #else
-concurrentMessage _o _iserror _msg fallback 
+concurrentMessage _s _iserror _msg fallback 
 #endif
 	| otherwise = fallback
 #ifdef WITH_CONCURRENTOUTPUT
@@ -50,8 +50,8 @@ concurrentMessage _o _iserror _msg fallback
 		-- console regions are in use, so set the errflag
 		-- to get it to display to stderr later.
 		when iserror $ do
-			Annex.changeState $ \s ->
-				s { Annex.output = (Annex.output s) { consoleRegionErrFlag = True } }
+			Annex.changeState $ \st ->
+				st { Annex.output = (Annex.output st) { consoleRegionErrFlag = True } }
 		liftIO $ atomically $ do
 			Regions.appendConsoleRegion r msg
 			rl <- takeTMVar Regions.regionList
@@ -68,24 +68,24 @@ concurrentMessage _o _iserror _msg fallback
  - When not at a console, a region is not displayed until the action is
  - complete.
  -}
-inOwnConsoleRegion :: OutputType -> Annex a -> Annex a
+inOwnConsoleRegion :: MessageState -> Annex a -> Annex a
 #ifdef WITH_CONCURRENTOUTPUT
-inOwnConsoleRegion o a
-	| concurrentOutputEnabled o = do
+inOwnConsoleRegion s a
+	| concurrentOutputEnabled s = do
 		r <- mkregion
 		setregion (Just r)
 		eret <- tryNonAsync a `onException` rmregion r
 		case eret of
 			Left e -> do
 				-- Add error message to region before it closes.
-				concurrentMessage o True (show e) noop
+				concurrentMessage s True (show e) noop
 				rmregion r
 				throwM e
 			Right ret -> do
 				rmregion r
 				return ret
 #else
-inOwnConsoleRegion _o a
+inOwnConsoleRegion _s a
 #endif
 	| otherwise = a
 #ifdef WITH_CONCURRENTOUTPUT
@@ -94,12 +94,13 @@ inOwnConsoleRegion _o a
 	-- a message is added to it. This avoids unnecessary screen
 	-- updates when a region does not turn out to need to be used.
 	mkregion = Regions.newConsoleRegion Regions.Linear ""
-	setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
+	setregion r = Annex.changeState $ \st -> st
+		{ Annex.output = (Annex.output st) { consoleRegion = r } }
 	rmregion r = do
 		errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
 		let h = if errflag then Console.StdErr else Console.StdOut
-		Annex.changeState $ \s ->
-			s { Annex.output = (Annex.output s) { consoleRegionErrFlag = False } }
+		Annex.changeState $ \st -> st
+			{ Annex.output = (Annex.output st) { consoleRegionErrFlag = False } }
 		setregion Nothing
 		liftIO $ atomically $ do
 			t <- Regions.getConsoleRegion r
@@ -135,7 +136,3 @@ concurrentOutputSupported = return True -- Windows is always unicode
 #else
 concurrentOutputSupported = return False
 #endif
-
-concurrentOutputEnabled :: OutputType -> Bool
-concurrentOutputEnabled (ConcurrentOutput _ b) = b
-concurrentOutputEnabled _ = False