arrange for regional output manager to run when -J is enabled

Commands that want to use it have to run their seek action inside
allowConcurrentOutput. Which seems reasonable; perhaps some future command
will want to support the -J flag but not use regions.

The region state moved from Annex to MessageState. This makes sense
organizationally, and note that some uses of onLocal use a different Annex
state, but pass the MessageState into it, which is what is needed.

12 files changed, 58 insertions, 50 deletions

diff --git a/Annex.hs b/Annex.hs
index 47147b358..c9a4ef6a0 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -65,9 +65,6 @@ import Utility.Quvi (QuviVersion)
 #endif
 import Utility.InodeCache
 import Utility.Url
-#ifdef WITH_CONCURRENTOUTPUT
-import System.Console.Regions (ConsoleRegion)
-#endif
 
 import "mtl" Control.Monad.Reader
 import Control.Concurrent
@@ -136,10 +133,7 @@ data AnnexState = AnnexState
 	, existinghooks :: M.Map Git.Hook.Hook Bool
 	, desktopnotify :: DesktopNotify
 	, workers :: [Either AnnexState (Async AnnexState)]
-#ifdef WITH_CONCURRENTOUTPUT
-	, consoleregion :: Maybe ConsoleRegion
-	, consoleregionerrflag :: Bool
-#endif
+	, concurrentjobs :: Maybe Int
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -184,10 +178,7 @@ newState c r = AnnexState
 	, existinghooks = M.empty
 	, desktopnotify = mempty
 	, workers = []
-#ifdef WITH_CONCURRENTOUTPUT
-	, consoleregion = Nothing
-	, consoleregionerrflag = True
-#endif
+	, concurrentjobs = Nothing
 	}
 
 {- Makes an Annex state object for the specified git repo.
diff --git a/CmdLine.hs b/CmdLine.hs
index 880f9de09..e6ee0c2e6 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -24,7 +24,6 @@ import Annex.Action
 import Annex.Environment
 import Command
 import Types.Messages
-import Messages.Internal
 
 {- Runs the passed command line. -}
 dispatch :: Bool -> CmdParams -> [Command] -> [GlobalOption] -> [(String, String)] -> IO Git.Repo -> String -> String -> IO ()
@@ -46,9 +45,8 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde
 			whenM (annexDebug <$> Annex.getGitConfig) $
 				liftIO enableDebugOutput
 			startup
-			withConcurrentOutput $
-				performCommandAction cmd seek $
-					shutdown $ cmdnocommit cmd
+			performCommandAction cmd seek $
+				shutdown $ cmdnocommit cmd
 	go (Left norepo) = do
 		let ingitrepo = \a -> a =<< Git.Config.global
 		-- Parse command line with full cmdparser first,
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index eeb41394a..73cffec76 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -56,7 +56,8 @@ commandAction a = withOutputType go
 			else do
 				l <- liftIO $ drainTo (n-1) ws
 				findFreeSlot l
-		w <- liftIO $ async $ snd <$> Annex.run st run
+		w <- liftIO $ async
+			$ snd <$> Annex.run st (inOwnConsoleRegion run)
 		Annex.changeState $ \s -> s { Annex.workers = Right w:ws' }
 	go _  =	run
 	run = void $ includeCommandAction a
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 06e04748d..b004e4239 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -282,13 +282,17 @@ jsonOption = globalFlag (Annex.setOutput JSONOutput)
 	<> hidden
 	)
 
+-- Note that a command that adds this option should wrap its seek
+-- action in `allowConcurrentOutput`.
 jobsOption :: GlobalOption
-jobsOption = globalSetter (Annex.setOutput . ConcurrentOutput) $ 
+jobsOption = globalSetter set $ 
 	option auto
 		( long "jobs" <> short 'J' <> metavar paramNumber
 		<> help "enable concurrent jobs"
 		<> hidden
 		)
+  where
+	set n = Annex.changeState $ \s -> s { Annex.concurrentjobs = Just n }
 
 timeLimitOption :: GlobalOption
 timeLimitOption = globalSetter Limit.addTimeLimit $ strOption
diff --git a/Command.hs b/Command.hs
index bee63bb74..17787539b 100644
--- a/Command.hs
+++ b/Command.hs
@@ -19,6 +19,7 @@ module Command (
 	whenAnnexed,
 	ifAnnexed,
 	isBareRepo,
+	allowConcurrentOutput,
 	module ReExported
 ) where
 
@@ -36,6 +37,7 @@ import CmdLine.Option as ReExported
 import CmdLine.GlobalSetter as ReExported
 import CmdLine.GitAnnex.Options as ReExported
 import Options.Applicative as ReExported hiding (command)
+import Messages.Internal (allowConcurrentOutput)
 
 import qualified Options.Applicative as O
 
diff --git a/Command/Get.hs b/Command/Get.hs
index 58fbefed2..07a501072 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -37,7 +37,7 @@ optParser desc = GetOptions
 	<*> optional (parseKeyOptions True)
 
 seek :: GetOptions -> CommandSeek
-seek o = do
+seek o = allowConcurrentOutput $ do
 	from <- maybe (pure Nothing) (Just <$$> getParsed) (getFrom o)
 	withKeyOptions (keyOptions o) (autoMode o)
 		(startKeys from)
diff --git a/Command/Mirror.hs b/Command/Mirror.hs
index a8caf9da7..148ca8d3c 100644
--- a/Command/Mirror.hs
+++ b/Command/Mirror.hs
@@ -41,10 +41,11 @@ instance DeferredParseClass MirrorOptions where
 		<*> pure (keyOptions v)
 
 seek :: MirrorOptions -> CommandSeek
-seek o = withKeyOptions (keyOptions o) False
-	(startKey o Nothing)
-	(withFilesInGit $ whenAnnexed $ start o)
-	(mirrorFiles o)
+seek o = allowConcurrentOutput $ 
+	withKeyOptions (keyOptions o) False
+		(startKey o Nothing)
+		(withFilesInGit $ whenAnnexed $ start o)
+		(mirrorFiles o)
 
 start :: MirrorOptions -> FilePath -> Key -> CommandStart
 start o file = startKey o (Just file)
diff --git a/Command/Move.hs b/Command/Move.hs
index 9a289d8b6..7a0b57c10 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -45,10 +45,11 @@ instance DeferredParseClass MoveOptions where
 		<*> pure (keyOptions v)
 
 seek :: MoveOptions -> CommandSeek
-seek o = withKeyOptions (keyOptions o) False
-	(startKey o True)
-	(withFilesInGit $ whenAnnexed $ start o True)
-	(moveFiles o)
+seek o = allowConcurrentOutput $ 
+	withKeyOptions (keyOptions o) False
+		(startKey o True)
+		(withFilesInGit $ whenAnnexed $ start o True)
+		(moveFiles o)
 
 start :: MoveOptions -> Bool -> FilePath -> Key -> CommandStart
 start o move = start' o move . Just
diff --git a/Command/Sync.hs b/Command/Sync.hs
index fffc113d2..2de92188b 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -93,7 +93,7 @@ optParser desc = SyncOptions
 	<*> optional parseAllOption
 
 seek :: SyncOptions -> CommandSeek
-seek o = do
+seek o = allowConcurrentOutput $ do
 	prepMerge
 
 	-- There may not be a branch checked out until after the commit,
diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 8bbb0cfc8..e4651238b 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{- git-annex output messages, including concurrent output
+{- git-annex output messages, including concurrent output to display regions
  -
  - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
@@ -58,35 +58,38 @@ flushed a = a >> hFlush stdout
  -}
 concurrentMessage :: Bool -> String -> Annex () -> Annex ()
 #ifdef WITH_CONCURRENTOUTPUT
-concurrentMessage iserror msg _ = go =<< Annex.getState Annex.consoleregion
+concurrentMessage iserror msg _ = go =<< consoleRegion <$> Annex.getState Annex.output
   where
 	go Nothing
 		| iserror = liftIO $ Console.errorConcurrent msg
-		| otherwise = liftIO $ Console.outputConcurrent msg
+		| otherwise = do
+			liftIO $ Console.outputConcurrent ("REGION MESSAGE NO REGION" ++ show msg)
+			liftIO $ Console.outputConcurrent msg
 	go (Just r) = do
+		liftIO $ Console.outputConcurrent ("REGION MESSAGE " ++ show msg)
 		-- Can't display the error to stdout while
 		-- console regions are in use, so set the errflag
 		-- to get it to display to stderr later.
-		when iserror $
-			Annex.changeState $ \s -> s { Annex.consoleregionerrflag = True }
+		when iserror $ do
+			Annex.changeState $ \s ->
+				s { Annex.output = (Annex.output s) { consoleRegionErrFlag = True } }
 		liftIO $ Regions.appendConsoleRegion r msg
 #else
 concurrentMessage _ _ fallback = fallback
 #endif
 
-{- Enable concurrent output when that has been requested.
- -
- - This should only be run once per git-annex lifetime, with
- - everything that might generate messages run inside it.
- -}
-withConcurrentOutput :: Annex a -> Annex a
+{- Do concurrent output when that has been requested. -}
+allowConcurrentOutput :: Annex a -> Annex a
 #ifdef WITH_CONCURRENTOUTPUT
-withConcurrentOutput a = withOutputType go
+allowConcurrentOutput a = go =<< Annex.getState Annex.concurrentjobs
   where
-	go (ConcurrentOutput _) = Console.withConcurrentOutput a
-	go _ = a
+	go (Just n) = Regions.displayConsoleRegions $ bracket_
+		(Annex.setOutput (ConcurrentOutput n))
+		(Annex.setOutput NormalOutput)
+		a
+	go Nothing = a
 #else
-withConcurrentOutput = id
+allowConcurrentOutput = id
 #endif
 
 {- Runs an action in its own dedicated region of the console.
@@ -103,11 +106,12 @@ inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
 	setregion (Just r)
 	a `finally` removeregion r
   where
-	setregion v = Annex.changeState $ \s -> s { Annex.consoleregion = v }
+	setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
 	removeregion r = do
-		errflag <- Annex.getState Annex.consoleregionerrflag
+		errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
 		let h = if errflag then Console.StdErr else Console.StdOut
-		Annex.changeState $ \s -> s { Annex.consoleregionerrflag = False }
+		Annex.changeState $ \s ->
+			s { Annex.output = (Annex.output s) { consoleRegionErrFlag = False } }
 		setregion Nothing
 		liftIO $ atomically $ do
 			t <- Regions.getConsoleRegion r
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index a20ba098e..89f2f0c8c 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -65,10 +65,7 @@ metered combinemeterupdate key af a = case keySize key of
 		return r
 #else
 	-- Old progress bar code, not suitable for concurrent output.
-	go _ (ConcurrentOutput _) = do
-		r <- nometer
-		liftIO $ putStrLn $ fromMaybe (key2file key) af
-		return r
+	go _ (ConcurrentOutput _) = nometer
 	go size NormalOutput = do
 		showOutput
 		progress <- liftIO $ newProgress "" size
diff --git a/Types/Messages.hs b/Types/Messages.hs
index 5cbb53057..0e60f36c8 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -5,11 +5,18 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE CPP #-}
+
 module Types.Messages where
 
 import Data.Default
 
+#ifdef WITH_CONCURRENTOUTPUT
+import System.Console.Regions (ConsoleRegion)
+#endif
+
 data OutputType = NormalOutput | QuietOutput | ConcurrentOutput Int | JSONOutput
+	deriving (Show)
 
 data SideActionBlock = NoBlock | StartBlock | InBlock
 	deriving (Eq)
@@ -17,8 +24,10 @@ data SideActionBlock = NoBlock | StartBlock | InBlock
 data MessageState = MessageState
 	{ outputType :: OutputType
 	, sideActionBlock :: SideActionBlock
+	, consoleRegion :: Maybe ConsoleRegion
+	, consoleRegionErrFlag :: Bool
 	}
 
 instance Default MessageState
   where
-	def = MessageState NormalOutput NoBlock
+	def = MessageState NormalOutput NoBlock Nothing False