From 70b8cad9c826ed57e9607a7ac9436e67d050413d Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 20 Jan 2016 14:07:13 -0400
Subject: [PATCH] make noMessages disable closing of json object in --json mode

This allows things like Command.Find to use noMessages and generate their
own complete json objects. Previouly, Command.Find managed that only via a
hack, which wasn't compatable with batch mode.

Only Command.Find, Command.Smudge, and Commange.Status use noMessages
currently, and none except for Command.Find are impacted by this change.

Fixes find --json --batch output
---
 CmdLine.hs        | 4 +++-
 CmdLine/Action.hs | 6 +++---
 Command.hs        | 7 +++++--
 Command/Status.hs | 9 +++++----
 Messages.hs       | 7 +++++++
 Types/Command.hs  | 2 +-
 Types/Messages.hs | 2 ++
 7 files changed, 26 insertions(+), 11 deletions(-)

diff --git a/CmdLine.hs b/CmdLine.hs
index e6ee0c2e6c..bc0f865242 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -39,8 +39,10 @@ dispatch fuzzyok allargs allcmds globaloptions fields getgitrepo progname progde
 			(cmd, seek, globalconfig) <- parsewith False cmdparser
 				(\a -> inRepo $ a . Just)
 				(liftIO . O.handleParseResult)
-			when (cmdnomessages cmd) $ 
+			when (cmdnomessages cmd) $ do
 				Annex.setOutput QuietOutput
+				Annex.changeState $ \s -> s 
+					{ Annex.output = (Annex.output s) { implicitMessages = False } }
 			getParsed globalconfig
 			whenM (annexDebug <$> Annex.getGitConfig) $
 				liftIO enableDebugOutput
diff --git a/CmdLine/Action.hs b/CmdLine/Action.hs
index 693a6814f0..b9fbf166ef 100644
--- a/CmdLine/Action.hs
+++ b/CmdLine/Action.hs
@@ -124,7 +124,7 @@ includeCommandAction a = account =<< tryIO (callCommandAction a)
 	account (Right False) = incerr
 	account (Left err) = do
 		toplevelWarning True (show err)
-		showEndFail
+		implicitMessage showEndFail
 		incerr
 	incerr = do
 		Annex.incError
@@ -146,8 +146,8 @@ callCommandAction' = start
 	cleanup = stage $ status
 	stage = (=<<)
 	skip = return Nothing
-	failure = showEndFail >> return (Just False)
-	status r = showEndResult r >> return (Just r)
+	failure = implicitMessage showEndFail >> return (Just False)
+	status r = implicitMessage (showEndResult r) >> return (Just r)
 
 {- Do concurrent output when that has been requested. -}
 allowConcurrentOutput :: Annex a -> Annex a
diff --git a/Command.hs b/Command.hs
index 387f7b8b56..e8c434b9b3 100644
--- a/Command.hs
+++ b/Command.hs
@@ -66,8 +66,11 @@ withParams mkseek paramdesc = mkseek <$> cmdParams paramdesc
 noCommit :: Command -> Command
 noCommit c = c { cmdnocommit = True }
 
-{- Indicates that a command should not output anything other than what
- - it directly sends to stdout. (--json can override this). -}
+{- Indicates that a command should not output the usual messages when
+ - starting or stopping processing a file or other item. Unless --json mode
+ - is enabled, this also enables quiet output mode, so only things
+ - explicitly output by the command are shown and not progress messages
+ - etc. -}
 noMessages :: Command -> Command
 noMessages c = c { cmdnomessages = True }
 
diff --git a/Command/Status.hs b/Command/Status.hs
index 3feea7cb44..af0a1282fd 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -17,10 +17,11 @@ import qualified Git.Ref
 import Git.FilePath
 
 cmd :: Command
-cmd = notBareRepo $ noCommit $ noMessages $ withGlobalOptions [jsonOption] $
-	command "status" SectionCommon
-		"show the working tree status"
-		paramPaths (withParams seek)
+cmd = notBareRepo $ noCommit $ noMessages $
+	withGlobalOptions [jsonOption] $
+		command "status" SectionCommon
+			"show the working tree status"
+			paramPaths (withParams seek)
 
 seek :: CmdParams -> CommandSeek
 seek = withWords start
diff --git a/Messages.hs b/Messages.hs
index 7b4cff1021..cec0cb8a32 100644
--- a/Messages.hs
+++ b/Messages.hs
@@ -36,6 +36,7 @@ module Messages (
 	debugEnabled,
 	commandProgressDisabled,
 	outputMessage,
+	implicitMessage,
 ) where
 
 import Text.JSON
@@ -212,3 +213,9 @@ commandProgressDisabled = withOutputType $ \t -> return $ case t of
 	JSONOutput -> True
 	NormalOutput -> False
 	ConcurrentOutput _ -> True
+
+{- Use to show a message that is displayed implicitly, and so might be
+ - disabled when running a certian command that needs more control over its
+ - output. -}
+implicitMessage :: Annex () -> Annex ()
+implicitMessage = whenM (implicitMessages <$> Annex.getState Annex.output)
diff --git a/Types/Command.hs b/Types/Command.hs
index e12873850a..aa22143dd2 100644
--- a/Types/Command.hs
+++ b/Types/Command.hs
@@ -40,7 +40,7 @@ type CommandCleanup = Annex Bool
 data Command = Command
 	{ cmdcheck :: [CommandCheck] -- check stage
 	, cmdnocommit :: Bool        -- don't commit journalled state changes
-	, cmdnomessages :: Bool      -- don't output normal messages
+	, cmdnomessages :: Bool -- don't output normal messages
 	, cmdname :: String
 	, cmdparamdesc :: CmdParamsDesc -- description of params for usage
 	, cmdsection :: CommandSection
diff --git a/Types/Messages.hs b/Types/Messages.hs
index e8dbb8e890..f9e09ecd79 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -24,6 +24,7 @@ data SideActionBlock = NoBlock | StartBlock | InBlock
 data MessageState = MessageState
 	{ outputType :: OutputType
 	, sideActionBlock :: SideActionBlock
+	, implicitMessages :: Bool
 #ifdef WITH_CONCURRENTOUTPUT
 	, consoleRegion :: Maybe ConsoleRegion
 	, consoleRegionErrFlag :: Bool
@@ -35,6 +36,7 @@ instance Default MessageState
 	def = MessageState
 		{ outputType = NormalOutput
 		, sideActionBlock = NoBlock
+		, implicitMessages = True 
 #ifdef WITH_CONCURRENTOUTPUT
 		, consoleRegion = Nothing
 		, consoleRegionErrFlag = False