refactor

Make all calls to git merge go through autoMergeFrom, in preparation
for fine-tuning git merge's config for automatic merge conflict
resolution.

This commit was sponsored by Ryan Newton on Patreon.

Annex/AdjustedBranch.hs

@@ -341,7 +341,7 @@ findAdjustingCommit (AdjBranch b) = go =<< catCommit b
 {- Update the currently checked out adjusted branch, merging the provided
  - branch into it. Note that the provided branch should be a non-adjusted
  - branch. -}
-mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool
+mergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> [Git.Merge.MergeConfig] -> Bool -> Git.Branch.CommitMode -> Annex Bool
 mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge commitmode = catchBoolIO $
 	join $ preventCommits go
   where
@@ -402,8 +402,8 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 				-- http://thread.gmane.org/gmane.comp.version-control.git/297237
 				inRepo $ Git.Command.run [Param "reset", Param "HEAD", Param "--quiet"]
 				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
-				merged <- inRepo (Git.Merge.merge' [] tomerge mergeconfig commitmode)
+				merged <- autoMergeFrom' tomerge Nothing mergeconfig commitmode
-					<||> (resolveMerge (Just updatedorig) tomerge True <&&> commitResolvedMerge commitmode)
+					(const $ resolveMerge (Just updatedorig) tomerge True)
 				if merged
 					then do
 						!mergecommit <- liftIO $ extractSha
@@ -439,7 +439,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 		-- this commit will be a fast-forward.
 		adjmergecommitff <- commitAdjustedTree' adjtree (BasisBranch mergecommit) [currbranch]
 		showAction "Merging into adjusted branch"
-		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig canresolvemerge commitmode)
+		ifM (autoMergeFrom adjmergecommitff (Just currbranch) mergeconfig commitmode canresolvemerge)
 			( reparent adjtree adjmergecommit =<< getcurrentcommit
 			, return False
 			)

Annex/AutoMerge.hs

@@ -1,6 +1,6 @@
 {- git-annex automatic merge conflict resolution
  -
- - Copyright 2012-2016 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -9,6 +9,7 @@
 
 module Annex.AutoMerge
 	( autoMergeFrom
+	, autoMergeFrom'
 	, resolveMerge
 	, commitResolvedMerge
 	) where
@@ -43,8 +44,16 @@ import qualified Data.ByteString.Lazy as L
  - Callers should use Git.Branch.changed first, to make sure that
  - there are changes from the current branch to the branch being merged in.
  -}
-autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> [Git.Merge.MergeConfig] -> Annex Bool -> Git.Branch.CommitMode -> Annex Bool
+autoMergeFrom :: Git.Ref -> Maybe Git.Ref -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> Bool -> Annex Bool
-autoMergeFrom branch currbranch mergeconfig canresolvemerge commitmode = do
+autoMergeFrom branch currbranch mergeconfig commitmode canresolvemerge =
+	autoMergeFrom' branch currbranch mergeconfig commitmode resolvemerge
+  where
+	resolvemerge old
+		| canresolvemerge = resolveMerge old branch False
+		| otherwise = return False 
+
+autoMergeFrom' :: Git.Ref -> Maybe Git.Ref -> [Git.Merge.MergeConfig] -> Git.Branch.CommitMode -> (Maybe Git.Ref -> Annex Bool) -> Annex Bool
+autoMergeFrom' branch currbranch mergeconfig commitmode resolvemerge = do
 	showOutput
 	case currbranch of
 		Nothing -> go Nothing
@@ -52,18 +61,13 @@ autoMergeFrom branch currbranch mergeconfig canresolvemerge commitmode = do
   where
 	go old = do
 			r <- inRepo (Git.Merge.merge branch mergeconfig commitmode)
-				<||> (resolvemerge <&&> commitResolvedMerge commitmode)
+				<||> (resolvemerge old <&&> commitResolvedMerge commitmode)
 			-- Merging can cause new associated files to appear
 			-- and the smudge filter will add them to the database.
 			-- To ensure that this process sees those changes,
 			-- close the database if it was open.
 			Database.Keys.closeDb
 			return r
-	  where
-		resolvemerge = ifM canresolvemerge
-			( resolveMerge old branch False
-			, return False 
-			)
 
 {- Resolves a conflicted merge. It's important that any conflicts be
  - resolved in a way that itself avoids later merge conflicts, since

Command/Sync.hs

@@ -268,13 +268,13 @@ mergeConfig =
 	]
 
 merge :: CurrBranch -> [Git.Merge.MergeConfig] -> SyncOptions -> Git.Branch.CommitMode -> Git.Branch -> Annex Bool
-merge currbranch mergeconfig o commitmode tomerge = case currbranch of
+merge currbranch mergeconfig o commitmode tomerge = do
-	(Just b, Just adj) -> mergeToAdjustedBranch tomerge (b, adj) mergeconfig canresolvemerge commitmode
+	canresolvemerge <- if resolveMergeOverride o
-	(b, _) -> autoMergeFrom tomerge b mergeconfig canresolvemerge commitmode
-  where
-	canresolvemerge = if resolveMergeOverride o
 		then getGitConfigVal annexResolveMerge
 		else return False
+	case currbranch of
+		(Just b, Just adj) -> mergeToAdjustedBranch tomerge (b, adj) mergeconfig canresolvemerge commitmode
+		(b, _) -> autoMergeFrom tomerge b mergeconfig commitmode canresolvemerge
 
 syncBranch :: Git.Branch -> Git.Branch
 syncBranch = Git.Ref.underBase "refs/heads/synced" . fromAdjustedBranch