From fa65f1d240142f22049c35e8fdea5b67bdda1784 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 19 Feb 2018 14:03:23 -0400
Subject: [PATCH] fix --json-progress --json to be same as --json
 --json-progress

Fix behavior of --json-progress followed by --json, in which
the latter option disabled the former.

This commit was supported by the NSF-funded DataLad project.
---
 Annex.hs                    |  3 ++-
 CHANGELOG                   |  2 ++
 CmdLine/GitAnnex/Options.hs | 12 ++++++++++--
 Messages/Progress.hs        | 15 ++++++++-------
 Types/Messages.hs           | 15 +++++++++++++--
 5 files changed, 35 insertions(+), 12 deletions(-)

diff --git a/Annex.hs b/Annex.hs
index 4ab7003327..7b4bb706cc 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -275,7 +275,8 @@ addCleanup k a = changeState $ \s ->
 {- Sets the type of output to emit. -}
 setOutput :: OutputType -> Annex ()
 setOutput o = changeState $ \s ->
-	s { output = (output s) { outputType = o } }
+	let m = output s
+	in s { output = m { outputType = adjustOutputType (outputType m) o } }
 
 {- Checks if a flag was set. -}
 getFlag :: String -> Annex Bool
diff --git a/CHANGELOG b/CHANGELOG
index 7d75e70d13..204004a601 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -17,6 +17,8 @@ git-annex (6.20180113) UNRELEASED; urgency=medium
     hopefully hackage finally recognises that OS.
   * Split Test.hs and avoid optimising it much, to need less memory to
     compile.
+  * Fix behavior of --json-progress followed by --json, in which
+    the latter option disabled the former.
 
  -- Joey Hess <id@joeyh.name>  Wed, 24 Jan 2018 20:42:55 -0400
 
diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index d762f6a009..51c55b0560 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -295,18 +295,26 @@ combiningOptions =
 	shortopt o h = globalFlag (Limit.addToken [o]) ( short o <> help h <> hidden )
 
 jsonOption :: GlobalOption
-jsonOption = globalFlag (Annex.setOutput (JSONOutput False))
+jsonOption = globalFlag (Annex.setOutput (JSONOutput jsonoptions))
 	( long "json" <> short 'j'
 	<> help "enable JSON output"
 	<> hidden
 	)
+  where
+	jsonoptions = JSONOptions
+		{ jsonProgress = False
+		}
 
 jsonProgressOption :: GlobalOption
-jsonProgressOption = globalFlag (Annex.setOutput (JSONOutput True))
+jsonProgressOption = globalFlag (Annex.setOutput (JSONOutput jsonoptions))
 	( long "json-progress"
 	<> help "include progress in JSON output"
 	<> hidden
 	)
+  where
+	jsonoptions = JSONOptions
+		{ jsonProgress = True
+		}
 
 -- Note that a command that adds this option should wrap its seek
 -- action in `allowConcurrentOutput`.
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index 61486d78d9..cb924eeac2 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -55,12 +55,13 @@ metered othermeter key getsrcfile a = withMessageState $ \st ->
 #else
 		nometer
 #endif
-	go _ (MessageState { outputType = JSONOutput False }) = nometer
-	go msize (MessageState { outputType = JSONOutput True }) = do
-		buf <- withMessageState $ return . jsonBuffer
-		m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
-			JSON.progress buf msize
-		a (combinemeter m)
+	go msize (MessageState { outputType = JSONOutput jsonoptions })
+		| jsonProgress jsonoptions = do
+			buf <- withMessageState $ return . jsonBuffer
+			m <- liftIO $ rateLimitMeterUpdate 0.1 msize $
+				JSON.progress buf msize
+			a (combinemeter m)
+		| otherwise = nometer
 
 	nometer = a $ combinemeter (const noop)
 
@@ -96,7 +97,7 @@ meteredFile file combinemeterupdate key a =
 
 needOutputMeter :: MessageState -> Bool
 needOutputMeter s = case outputType s of
-	JSONOutput True -> True
+	JSONOutput jsonoptions -> jsonProgress jsonoptions
 	NormalOutput | concurrentOutputEnabled s -> True
 	_ -> False
 
diff --git a/Types/Messages.hs b/Types/Messages.hs
index 551531349c..f259f3200b 100644
--- a/Types/Messages.hs
+++ b/Types/Messages.hs
@@ -1,6 +1,6 @@
 {- git-annex Messages data types
  - 
- - Copyright 2012-2017 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2018 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -16,9 +16,20 @@ import Control.Concurrent
 import System.Console.Regions (ConsoleRegion)
 #endif
 
-data OutputType = NormalOutput | QuietOutput | JSONOutput Bool
+data OutputType = NormalOutput | QuietOutput | JSONOutput JSONOptions
 	deriving (Show)
 
+data JSONOptions = JSONOptions
+	{ jsonProgress :: Bool
+	}
+	deriving (Show)
+
+adjustOutputType :: OutputType -> OutputType -> OutputType
+adjustOutputType (JSONOutput old) (JSONOutput new) = JSONOutput $ JSONOptions
+	{ jsonProgress = jsonProgress old || jsonProgress new
+	}
+adjustOutputType _old new = new
+
 data SideActionBlock = NoBlock | StartBlock | InBlock
 	deriving (Eq)