sync --quiet

* sync: When --quiet is used, run git commit, push, and pull without
  their ususual output.
* merge: When --quiet is used, run git merge without its usual output.

This might also make --quiet work better for some other commands
that make commits, like git-annex adjust.

Sponsored-by: Kevin Mueller on Patreon

Annex/AdjustedBranch.hs

@@ -362,9 +362,9 @@ adjustToCrippledFileSystem = do
 commitForAdjustedBranch :: [CommandParam] -> Annex ()
 commitForAdjustedBranch ps = do
 	cmode <- annexCommitMode <$> Annex.getGitConfig
-	void $ inRepo $ Git.Branch.commitCommand cmode $
+	let cquiet = Git.Branch.CommitQuiet True
-		[ Param "--quiet"
+	void $ inRepo $ Git.Branch.commitCommand cmode cquiet $
-		, Param "--allow-empty"
+		[ Param "--allow-empty"
 		, Param "-m"
 		, Param "commit before entering adjusted branch"
 		] ++ ps

Annex/AutoMerge.hs

@@ -352,11 +352,13 @@ reuseOldFile srcmap key origfile destfile = do
 		| otherwise = go fs
 	
 commitResolvedMerge :: Git.Branch.CommitMode -> Annex Bool
-commitResolvedMerge commitmode = inRepo $ Git.Branch.commitCommand commitmode
+commitResolvedMerge commitmode = do
-	[ Param "--no-verify"
+	commitquiet <- Git.Branch.CommitQuiet <$> commandProgressDisabled
-	, Param "-m"
+	inRepo $ Git.Branch.commitCommand commitmode commitquiet
-	, Param "git-annex automatic merge conflict fix"
+		[ Param "--no-verify"
-	]
+		, Param "-m"
+		, Param "git-annex automatic merge conflict fix"
+		]
 
 type InodeMap = M.Map (Either FilePath InodeCacheKey) FilePath
 

Assistant/MakeRepo.hs

@@ -60,8 +60,8 @@ initRepo True primary_assistant_repo dir desc mgroup = inDir dir $ do
 	unlessM (Git.Config.isBare <$> gitRepo) $ do
 		cmode <- annexCommitMode <$> Annex.getGitConfig
 		void $ inRepo $ Git.Branch.commitCommand cmode
-			[ Param "--quiet"
+			(Git.Branch.CommitQuiet True)
-			, Param "--allow-empty"
+			[ Param "--allow-empty"
 			, Param "-m"
 			, Param "created repository"
 			]

Assistant/Sync.hs

@@ -21,6 +21,7 @@ import qualified Git
 import qualified Git.Command
 import qualified Remote
 import qualified Types.Remote as Remote
+import qualified Annex
 import qualified Annex.Branch
 import Remote.List.Util
 import Annex.UUID
@@ -125,25 +126,26 @@ pushToRemotes remotes = do
 
 pushToRemotes' :: UTCTime -> [Remote] -> Assistant [Remote]
 pushToRemotes' now remotes = do
-	(g, branch, u) <- liftAnnex $ do
+	(g, branch, u, ms) <- liftAnnex $ do
 		Annex.Branch.commit =<< Annex.Branch.commitMessage
-		(,,)
+		(,,,)
 			<$> gitRepo
 			<*> getCurrentBranch
 			<*> getUUID
-	ret <- go True branch g u remotes
+			<*> Annex.getState Annex.output
+	ret <- go ms True branch g u remotes
 	return ret
   where
-	go _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
+	go _ _ (Nothing, _) _ _ _ = return [] -- no branch, so nothing to do
-	go _ _ _ _ [] = return [] -- no remotes, so nothing to do
+	go _ _ _ _ _ [] = return [] -- no remotes, so nothing to do
-	go shouldretry currbranch@(Just branch, _) g u rs =  do
+	go ms shouldretry currbranch@(Just branch, _) g u rs =  do
 		debug ["pushing to", show rs]
-		(succeeded, failed) <- parallelPush g rs (push branch)
+		(succeeded, failed) <- parallelPush g rs (push ms branch)
 		updatemap succeeded []
 		if null failed
 			then return []
 			else if shouldretry
-				then retry currbranch g u failed
+				then retry ms currbranch g u failed
 				else fallback branch g u failed
 
 	updatemap succeeded failed = do
@@ -153,10 +155,10 @@ pushToRemotes' now remotes = do
 				M.difference m (makemap succeeded)
 	makemap l = M.fromList $ zip l (repeat now)
 
-	retry currbranch g u rs = do
+	retry ms currbranch g u rs = do
 		debug ["trying manual pull to resolve failed pushes"]
 		void $ manualPull currbranch rs
-		go False currbranch g u rs
+		go ms False currbranch g u rs
 
 	fallback branch g u rs = do
 		debug ["fallback pushing to", show rs]
@@ -164,7 +166,7 @@ pushToRemotes' now remotes = do
 		updatemap succeeded failed
 		return failed
 		
-	push branch remote = Command.Sync.pushBranch remote (Just branch)
+	push ms branch remote = Command.Sync.pushBranch remote (Just branch) ms
 
 parallelPush :: Git.Repo -> [Remote] -> (Remote -> Git.Repo -> IO Bool)-> Assistant ([Remote], [Remote])
 parallelPush g rs a = do
@@ -211,6 +213,7 @@ syncAction rs a
 manualPull :: Command.Sync.CurrBranch -> [Remote] -> Assistant ([Remote], Bool)
 manualPull currentbranch remotes = do
 	g <- liftAnnex gitRepo
+	mc <- liftAnnex Command.Sync.mergeConfig
 	failed <- forM remotes $ \r -> if wantpull $ Remote.gitconfig r
 		then do
 			g' <- liftAnnex $ do
@@ -225,7 +228,7 @@ manualPull currentbranch remotes = do
 		<$> liftAnnex Annex.Branch.forceUpdate
 	forM_ remotes $ \r ->
 		liftAnnex $ Command.Sync.mergeRemote r
-			currentbranch Command.Sync.mergeConfig def
+			currentbranch mc def
 	when haddiverged $
 		updateExportTreeFromLogAll
 	return (catMaybes failed, haddiverged)

Assistant/Threads/Merger.hs

@@ -90,8 +90,10 @@ onChange file
 					]
 				void $ liftAnnex $ do
 					cmode <- annexCommitMode <$> Annex.getGitConfig
+					mc <- Command.Sync.mergeConfig
 					Command.Sync.merge
-						currbranch Command.Sync.mergeConfig
+						currbranch
+						mc
 						def
 						cmode
 						changedbranch

CHANGELOG

@@ -6,6 +6,9 @@ git-annex (8.20210715) UNRELEASED; urgency=medium
     started out as a bare repository, or had annex.crippledfilesystem
     set, and was converted to a non-bare repository.
   * Fix retrieval of content from borg repos accessed over ssh.
+  * sync: When --quiet is used, run git commit, push, and pull without
+    their ususual output.
+  * merge: When --quiet is used, run git merge without its usual output.
 
  -- Joey Hess <id@joeyh.name>  Wed, 14 Jul 2021 14:26:36 -0400
 

Command/Merge.hs

@@ -40,13 +40,16 @@ mergeAnnexBranch = starting "merge" ai si $ do
 	si = SeekInput []
 
 mergeSyncedBranch :: CommandStart
-mergeSyncedBranch = mergeLocal mergeConfig def =<< getCurrentBranch
+mergeSyncedBranch = do
+	mc <- mergeConfig
+	mergeLocal mc def =<< getCurrentBranch
 
 mergeBranch :: Git.Ref -> CommandStart
 mergeBranch r = starting "merge" ai si $ do
 	currbranch <- getCurrentBranch
 	let o = def { notOnlyAnnexOption = True }
-	next $ merge currbranch mergeConfig o Git.Branch.ManualCommit r
+	mc <- mergeConfig
+	next $ merge currbranch mc o Git.Branch.ManualCommit r
   where
 	ai = ActionItemOther (Just (Git.fromRef r))
 	si = SeekInput []

Command/PostReceive.hs

@@ -52,4 +52,5 @@ updateInsteadEmulation :: CommandStart
 updateInsteadEmulation = do
 	prepMerge
 	let o = def { notOnlyAnnexOption = True }
-	mergeLocal mergeConfig o =<< getCurrentBranch
+	mc <- mergeConfig
+	mergeLocal mc o =<< getCurrentBranch

Command/Sync.hs

@@ -218,21 +218,23 @@ seek' o = do
 			commandAction (withbranch cleanupLocal)
 			mapM_ (commandAction . withbranch . cleanupRemote) gitremotes
 		else do
+			mc <- mergeConfig
+
 			-- Syncing involves many actions, any of which
 			-- can independently fail, without preventing
 			-- the others from running. 
 			-- These actions cannot be run concurrently.
 			mapM_ includeCommandAction $ concat
 				[ [ commit o ]
-				, [ withbranch (mergeLocal mergeConfig o) ]
+				, [ withbranch (mergeLocal mc o) ]
-				, map (withbranch . pullRemote o mergeConfig) gitremotes
+				, map (withbranch . pullRemote o mc) gitremotes
 				,  [ mergeAnnex ]
 				]
 			
 			content <- shouldSyncContent o
 
 			forM_ (filter isImport contentremotes) $
-				withbranch . importRemote content o mergeConfig
+				withbranch . importRemote content o mc
 			forM_ (filter isThirdPartyPopulated contentremotes) $
 				pullThirdPartyPopulated o
 			
@@ -259,7 +261,7 @@ seek' o = do
 				-- avoid our push overwriting those changes.
 				when (syncedcontent || exportedcontent) $ do
 					mapM_ includeCommandAction $ concat
-						[ map (withbranch . pullRemote o mergeConfig) gitremotes
+						[ map (withbranch . pullRemote o mc) gitremotes
 						, [ commitAnnex, mergeAnnex ]
 						]
 	
@@ -273,17 +275,21 @@ seek' o = do
 prepMerge :: Annex ()
 prepMerge = Annex.changeDirectory . fromRawFilePath =<< fromRepo Git.repoPath
 
-mergeConfig :: [Git.Merge.MergeConfig]	
+mergeConfig :: Annex [Git.Merge.MergeConfig]
-mergeConfig = 
+mergeConfig = do
-	[ Git.Merge.MergeNonInteractive
+	quiet <- commandProgressDisabled
-	-- In several situations, unrelated histories should be merged
+	return $ catMaybes
-	-- together. This includes pairing in the assistant, merging
+		[ Just Git.Merge.MergeNonInteractive
-	-- from a remote into a newly created direct mode repo,
+		-- In several situations, unrelated histories should be
-	-- and an initial merge from an import from a special remote.
+		-- merged together. This includes pairing in the assistant,
-	-- (Once direct mode is removed, this could be changed, so only
+		-- merging from a remote into a newly created direct mode
-	-- the assistant and import from special remotes use it.)
+		-- repo, and an initial merge from an import from a special
-	, Git.Merge.MergeUnrelatedHistories
+		-- remote. (Once direct mode is removed, this could be
-	]
+		-- changed, so only the assistant and import from special
+		-- remotes use it.)
+		, Just Git.Merge.MergeUnrelatedHistories
+		, if quiet then Just Git.Merge.MergeQuiet else Nothing
+		]
 
 merge :: CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
 merge currbranch mergeconfig o commitmode tomerge = do
@@ -331,7 +337,9 @@ commit o = stopUnless shouldcommit $ starting "commit" ai si $ do
 	Annex.Branch.commit =<< Annex.Branch.commitMessage
 	next $ do
 		showOutput
-		void $ inRepo $ Git.Branch.commitCommand Git.Branch.ManualCommit
+		let cmode = Git.Branch.ManualCommit
+		cquiet <- Git.Branch.CommitQuiet <$> commandProgressDisabled
+		void $ inRepo $ Git.Branch.commitCommand cmode cquiet
 			[ Param "-a"
 			, Param "-m"
 			, Param commitmessage
@@ -462,10 +470,15 @@ pullRemote o mergeconfig remote branch = stopUnless (pure $ pullOption o && want
   where
 	fetch bs = do
 		repo <- Remote.getRepo remote
+		ms <- Annex.getState Annex.output
 		inRepoWithSshOptionsTo repo (Remote.gitconfig remote) $
-			Git.Command.runBool $
+			Git.Command.runBool $ catMaybes
-				[Param "fetch", Param $ Remote.name remote]
+				[ Just $ Param "fetch"
-					++ map Param bs
+				, if commandProgressDisabled' ms
+					then Just $ Param "--quiet"
+					else Nothing
+				, Just $ Param $ Remote.name remote
+				] ++ map Param bs
 	wantpull = remoteAnnexPull (Remote.gitconfig remote)
 	ai = ActionItemOther (Just (Remote.name remote))
 	si = SeekInput []
@@ -548,8 +561,9 @@ pushRemote o remote (Just branch, _) = do
 		starting "push" ai si $ next $ do
 			repo <- Remote.getRepo remote
 			showOutput
+			ms <- Annex.getState Annex.output
 			ok <- inRepoWithSshOptionsTo repo gc $
-				pushBranch remote mainbranch
+				pushBranch remote mainbranch ms
 			if ok
 				then postpushupdate repo
 				else do
@@ -621,8 +635,8 @@ pushRemote o remote (Just branch, _) = do
  - The only difference caused by using a forced push in that case is that
  - the last repository to push wins the race, rather than the first to push.
  -}
-pushBranch :: Remote -> Maybe Git.Branch -> Git.Repo -> IO Bool
+pushBranch :: Remote -> Maybe Git.Branch -> MessageState -> Git.Repo -> IO Bool
-pushBranch remote mbranch g = directpush `after` annexpush `after` syncpush
+pushBranch remote mbranch ms g = directpush `after` annexpush `after` syncpush
   where
 	syncpush = flip Git.Command.runBool g $ pushparams $ catMaybes
 		[ (refspec . fromAdjustedBranch) <$> mbranch
@@ -648,9 +662,12 @@ pushBranch remote mbranch g = directpush `after` annexpush `after` syncpush
 			(transcript, ok) <- processTranscript' p Nothing
 			when (not ok && not ("denyCurrentBranch" `isInfixOf` transcript)) $
 				hPutStr stderr transcript
-	pushparams branches =
+	pushparams branches = catMaybes
-		[ Param "push"
+		[ Just $ Param "push"
-		, Param $ Remote.name remote
+		, if commandProgressDisabled' ms
+			then Just $ Param "--quiet"
+			else Nothing
+		, Just $ Param $ Remote.name remote
 		] ++ map Param branches
 	refspec b = concat 
 		[ Git.fromRef $ Git.Ref.base b

Git/Branch.hs

@@ -121,6 +121,13 @@ fastForward branch (first:rest) repo =
 			(False, True) -> findbest c rs -- worse
 			(False, False) -> findbest c rs -- same
 
+{- Should the commit avoid the usual summary output? -}
+newtype CommitQuiet = CommitQuiet Bool
+
+applyCommitQuiet :: CommitQuiet -> [CommandParam] -> [CommandParam]
+applyCommitQuiet (CommitQuiet True) ps = Param "--quiet" : ps
+applyCommitQuiet (CommitQuiet False) ps = ps
+
 {- The user may have set commit.gpgsign, intending all their manual
  - commits to be signed. But signing automatic/background commits could
  - easily lead to unwanted gpg prompts or failures.
@@ -148,12 +155,14 @@ applyCommitModeForCommitTree commitmode ps r
 	ps' = applyCommitMode commitmode ps
 
 {- Commit via the usual git command. -}
-commitCommand :: CommitMode -> [CommandParam] -> Repo -> IO Bool
+commitCommand :: CommitMode -> CommitQuiet -> [CommandParam] -> Repo -> IO Bool
 commitCommand = commitCommand' runBool
 
-commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> [CommandParam] -> Repo -> IO a
+commitCommand' :: ([CommandParam] -> Repo -> IO a) -> CommitMode -> CommitQuiet -> [CommandParam] -> Repo -> IO a
-commitCommand' runner commitmode ps = runner $
+commitCommand' runner commitmode commitquiet ps =
-	Param "commit" : applyCommitMode commitmode ps
+	runner $ Param "commit" : ps'
+  where
+	ps' = applyCommitMode commitmode (applyCommitQuiet commitquiet ps)
 
 {- Commits the index into the specified branch (or other ref), 
  - with the specified parent refs, and returns the committed sha.
@@ -162,7 +171,7 @@ commitCommand' runner commitmode ps = runner $
  - one parent, and it has the same tree that would be committed.
  -
  - Unlike git-commit, does not run any hooks, or examine the work tree
- - in any way.
+ - in any way, or output a summary.
  -}
 commit :: CommitMode -> Bool -> String -> Branch -> [Ref] -> Repo -> IO (Maybe Sha)
 commit commitmode allowempty message branch parentrefs repo = do

Git/Merge.hs

@@ -1,6 +1,6 @@
 {- git merging
  -
- - Copyright 2012-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -22,9 +22,12 @@ import Git.Branch (CommitMode(..))
 
 data MergeConfig
 	= MergeNonInteractive
-	-- ^ avoids interactive merge
+	-- ^ avoids interactive merge with commit message edit
 	| MergeUnrelatedHistories
 	-- ^ avoids git's prevention of merging unrelated histories
+	| MergeQuiet
+	-- ^ avoids usual output when merging, but errors will still be
+	-- displayed
 	deriving (Eq)
 
 merge :: Ref -> [MergeConfig] -> CommitMode -> Repo -> IO Bool
@@ -36,11 +39,14 @@ merge' extraparams branch mergeconfig commitmode r
 		go [Param $ fromRef branch]
 	| otherwise = go [Param "--no-edit", Param $ fromRef branch]
   where
-	go ps = merge'' (sp ++ [Param "merge"] ++ ps ++ extraparams) mergeconfig r
+	go ps = merge'' (sp ++ [Param "merge"] ++ qp ++ ps ++ extraparams) mergeconfig r
 	sp
 		| commitmode == AutomaticCommit =
 			[Param "-c", Param "commit.gpgsign=false"]
 		| otherwise = []
+	qp
+		| MergeQuiet `notElem` mergeconfig = []
+		| otherwise = [Param "--quiet"]
 
 merge'' :: [CommandParam] -> [MergeConfig] -> Repo -> IO Bool
 merge'' ps mergeconfig r

Messages.hs

@@ -43,9 +43,11 @@ module Messages (
 	setupConsole,
 	enableDebugOutput,
 	commandProgressDisabled,
+	commandProgressDisabled',
 	jsonOutputEnabled,
 	outputMessage,
 	withMessageState,
+	MessageState,
 	prompt,
 	mkPrompter,
 ) where
@@ -276,12 +278,14 @@ debugDisplayer = do
 {- Should commands that normally output progress messages have that
  - output disabled? -}
 commandProgressDisabled :: Annex Bool
-commandProgressDisabled = withMessageState $ \s -> return $
+commandProgressDisabled = withMessageState $ return . commandProgressDisabled'
-	case outputType s of
+
-		NormalOutput -> concurrentOutputEnabled s
+commandProgressDisabled' :: MessageState -> Bool
-		QuietOutput -> True
+commandProgressDisabled' s = case outputType s of
-		JSONOutput _ -> True
+	NormalOutput -> concurrentOutputEnabled s
-		SerializedOutput _ _ -> True
+	QuietOutput -> True
+	JSONOutput _ -> True
+	SerializedOutput _ _ -> True
 
 jsonOutputEnabled :: Annex Bool
 jsonOutputEnabled = withMessageState $ \s -> return $

doc/forum/using_--quiet_with_sync/comment_1_69c2034761a8b92b001b142e49f0449e._comment

@@ -0,0 +1,9 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2021-07-19T15:24:55Z"
+ content="""
+It's perfectly fine to file a bug report if you find something like this.
+
+Nobody seems to have wanted that before.. I've implemented it now.
+"""]]