From cac7297784a4eb953f0d6108d7e67e97be9285ad Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 9 Sep 2016 12:57:42 -0400
Subject: 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.
---
 CmdLine/Action.hs           | 27 +++++++++++++++------------
 CmdLine/GitAnnex/Options.hs |  3 ++-
 2 files changed, 17 insertions(+), 13 deletions(-)

(limited to 'CmdLine')

diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 9b7cf7ecd..7d9dce574 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -13,6 +13,7 @@ import Annex.Common
 import qualified Annex
 import Annex.Concurrent
 import Types.Command
+import Types.Concurrency
 import Messages.Concurrent
 import Types.Messages
 
@@ -50,9 +51,9 @@ performCommandAction Command { cmdcheck = c, cmdname = name } seek cont = do
  - This should only be run in the seek stage.
  -}
 commandAction :: CommandStart -> Annex ()
-commandAction a = withOutputType go 
+commandAction a = go =<< Annex.getState Annex.concurrency
   where
-	go o@(ConcurrentOutput n _) = do
+	go (Concurrent n) = do
 		ws <- Annex.getState Annex.workers
 		(st, ws') <- if null ws
 			then do
@@ -62,9 +63,9 @@ commandAction a = withOutputType go
 				l <- liftIO $ drainTo (n-1) ws
 				findFreeSlot l
 		w <- liftIO $ async
-			$ snd <$> Annex.run st (inOwnConsoleRegion o run)
+			$ snd <$> Annex.run st (inOwnConsoleRegion (Annex.output st) run)
 		Annex.changeState $ \s -> s { Annex.workers = Right w:ws' }
-	go _  =	run
+	go NonConcurrent = run
 	run = void $ includeCommandAction a
 
 {- Waits for any forked off command actions to finish.
@@ -151,19 +152,21 @@ callCommandAction' = start
 {- Do concurrent output when that has been requested. -}
 allowConcurrentOutput :: Annex a -> Annex a
 #ifdef WITH_CONCURRENTOUTPUT
-allowConcurrentOutput a = go =<< Annex.getState Annex.concurrentjobs
+allowConcurrentOutput a = go =<< Annex.getState Annex.concurrency
   where
-	go Nothing = a
-	go (Just n) = ifM (liftIO concurrentOutputSupported)
+	go NonConcurrent = a
+	go (Concurrent _) = ifM (liftIO concurrentOutputSupported)
 		( Regions.displayConsoleRegions $
-			goconcurrent (ConcurrentOutput n True)
-		, goconcurrent (ConcurrentOutput n False)
+			goconcurrent True
+		, goconcurrent False
 		)
-	goconcurrent o = bracket_ (setup o) cleanup a
-	setup = Annex.setOutput
+	goconcurrent b = bracket_ (setup b) cleanup a
+	setup = setconcurrentenabled
 	cleanup = do
 		finishCommandActions
-		Annex.setOutput NormalOutput
+		setconcurrentenabled False
+	setconcurrentenabled b = Annex.changeState $ \s ->
+		s { Annex.output = (Annex.output s) { concurrentOutputEnabled = b } }
 #else
 allowConcurrentOutput = id
 #endif
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 64f70d178..1c360de19 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -21,6 +21,7 @@ import Types.Messages
 import Types.Command
 import Types.DeferredParse
 import Types.DesktopNotify
+import Types.Concurrency
 import qualified Annex
 import qualified Remote
 import qualified Limit
@@ -302,7 +303,7 @@ jobsOption = globalSetter set $
 		)
   where
 	set n = do
-		Annex.changeState $ \s -> s { Annex.concurrentjobs = Just n }
+		Annex.changeState $ \s -> s { Annex.concurrency = Concurrent n }
 		c <- liftIO getNumCapabilities
 		when (n > c) $
 			liftIO $ setNumCapabilities n
-- 
cgit v1.2.3