new method for merging changes into adjusted branch that avoids unncessary merge conflicts

Still needs work when there are actual merge conflicts.

7 files changed, 159 insertions, 104 deletions

diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
index a70c3a75d..8d2d498e6 100644
--- a/Annex/AdjustedBranch.hs
+++ b/Annex/AdjustedBranch.hs
@@ -5,6 +5,8 @@
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
+{-# LANGUAGE BangPatterns #-}
+
 module Annex.AdjustedBranch (
 	Adjustment(..),
 	OrigBranch,
@@ -40,6 +42,9 @@ import Annex.CatFile
 import Annex.Link
 import Annex.AutoMerge
 import Annex.Content
+import Annex.Perms
+import Annex.GitOverlay
+import Utility.Tmp
 import qualified Database.Keys
 
 import qualified Data.Map as M
@@ -137,7 +142,7 @@ originalBranch = fmap fromAdjustedBranch <$> inRepo Git.Branch.current
 
 {- Enter an adjusted version of current branch (or, if already in an
  - adjusted version of a branch, changes the adjustment of the original
- - branch).
+ t a- branch).
  -
  - Can fail, if no branch is checked out, or perhaps if staged changes
  - conflict with the adjusted branch.
@@ -225,80 +230,91 @@ adjustedBranchCommitMessage :: String
 adjustedBranchCommitMessage = "git-annex adjusted branch"
 
 {- Update the currently checked out adjusted branch, merging the provided
- - branch into it. -}
+ - branch into it. Note that the provided branch should be a non-adjusted
+ - branch. -}
 updateAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Git.Branch.CommitMode -> Annex Bool
 updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
-	join $ preventCommits $ \commitsprevented -> go commitsprevented =<< (,)
-		<$> inRepo (Git.Ref.sha tomerge)
-		<*> inRepo Git.Branch.current
+	join $ preventCommits $ \commitsprevented ->
+		go commitsprevented =<< inRepo Git.Branch.current
   where
-	go commitsprevented (Just mergesha, Just currbranch) =
-		ifM (inRepo $ Git.Branch.changed currbranch mergesha)
+	go commitsprevented (Just currbranch) =
+		ifM (inRepo $ Git.Branch.changed currbranch tomerge)
 			( do
-				void $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
-				adjustedtomerge <- adjust adj mergesha
-				ifM (inRepo $ Git.Branch.changed currbranch adjustedtomerge)
-					( return $ do
-						-- Run after commit lock is dropped.
-						liftIO $ print ("autoMergeFrom", adjustedtomerge, (Just currbranch))
-						ifM (autoMergeFrom adjustedtomerge (Just currbranch) commitmode)
-							( preventCommits $ \_ ->
-								recommit currbranch mergesha =<< catCommit currbranch
-							, return False
-							)
-					, nochangestomerge
-					)
+				(updatedorig, _) <- propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+				changestomerge updatedorig currbranch
 			, nochangestomerge
 			)
 	go _ _ = return $ return False
+
 	nochangestomerge = return $ return True
 
-	{- A merge commit has been made on the adjusted branch.
-	 - Now, re-do it, removing the old version of the adjusted branch
-	 - from its history.
+	{- Since the adjusted branch changes files, merging tomerge
+	 - directly into it would likely result in unncessary merge
+	 - conflicts. To avoid those conflicts, instead merge tomerge into
+	 - updatedorig. The result of the merge can the be
+	 - adjusted to yield the final adjusted branch.
 	 -
-	 - There are two possible scenarios; either some commits
-	 - were made on top of the adjusted branch's adjusting commit,
-	 - or not. Those commits have already been propigated to the
-	 - orig branch, so we can just check if there are commits in the
-	 - orig branch that are not present in tomerge.
+	 - In order to do a merge into a branch that is not checked out,
+	 - set the work tree to a temp directory, and set GIT_DIR
+	 - to another temp directory, in which HEAD contains the
+	 - updatedorig sha. GIT_COMMON_DIR is set to point to the real
+	 - git directory, and so git can read and write objects from there,
+	 - but will use GIT_DIR for HEAD and index.
+	 -
+	 - (Doing the merge this way also lets it run even though the main
+	 - index file is currently locked.)
 	 -}
-	recommit currbranch mergedsha (Just mergecommit) =
-		ifM (inRepo $ Git.Branch.changed tomerge origbranch)
-			( remerge currbranch mergedsha mergecommit
-				=<< inRepo (Git.Ref.sha origbranch)
-			, fastforward currbranch mergedsha mergecommit
-			)
-	recommit _ _ Nothing = return False
-
-	{- Fast-forward scenario. The mergecommit is changed to a non-merge
-	 - commit, with its parent being the mergedsha. 
-	 - The orig branch can simply be pointed at the mergedsha.
+	changestomerge (Just updatedorig) currbranch = do
+		misctmpdir <- fromRepo gitAnnexTmpMiscDir
+		void $ createAnnexDirectory misctmpdir
+		tmpwt <- fromRepo gitAnnexMergeDir
+		withTmpDirIn misctmpdir "git" $ \tmpgit -> withWorkTreeRelated tmpgit $
+			withemptydir tmpwt $ withWorkTree tmpwt $ do
+				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
+				showAction $ "Merging into " ++ fromRef (Git.Ref.base origbranch)
+				ifM (autoMergeFrom tomerge (Just updatedorig) commitmode)
+					( do
+						!mergecommit <- liftIO $ extractSha <$> readFile (tmpgit </> "HEAD")
+						-- This is run after the commit lock is dropped.
+						return $ postmerge currbranch mergecommit
+					, return $ return False
+					)
+	changestomerge Nothing _ = return $ return False
+	
+	withemptydir d a = bracketIO setup cleanup (const a)
+	  where
+		setup = do
+			whenM (doesDirectoryExist d) $
+				removeDirectoryRecursive d
+			createDirectoryIfMissing True d
+		cleanup _ = removeDirectoryRecursive d
+
+	{- A merge commit has been made between the origbranch and 
+	 - tomerge. Update origbranch to point to that commit, adjust
+	 - it to get the new adjusted branch, and check it out.
+	 -
+	 - But, there may be unstaged work tree changes that conflict, 
+	 - so the check out is done by making a normal merge of
+	 - the new adjusted branch.
 	 -}
-	fastforward currbranch mergedsha mergecommit = do
-		commitsha <- commitAdjustedTree (commitTree mergecommit) mergedsha
-		inRepo $ Git.Branch.update "fast-forward update of adjusted branch" currbranch commitsha
-		inRepo $ Git.Branch.update "updating original branch" origbranch mergedsha
-		return True
-		
-	{- True merge scenario. -}
-	remerge currbranch mergedsha mergecommit (Just origsha) = do
-	 	-- Update origbranch by reverse adjusting the mergecommit,
-		-- yielding a merge between orig and tomerge.
-		treesha <- reverseAdjustedTree origsha adj
-			-- get 1-parent commit because 
-			-- reverseAdjustedTree does not support merges
-			=<< commitAdjustedTree (commitTree mergecommit) origsha
-		revadjcommit <- inRepo $
-			Git.Branch.commitTree Git.Branch.AutomaticCommit
-				("Merge branch " ++ fromRef tomerge) [origsha, mergedsha] treesha
-		inRepo $ Git.Branch.update "updating original branch" origbranch revadjcommit
-		-- Update currbranch, reusing mergedsha, but making its
-		-- parent be the updated origbranch.
-		adjcommit <- commitAdjustedTree' (commitTree mergecommit) revadjcommit [revadjcommit]
-		inRepo $ Git.Branch.update rebaseOnTopMsg currbranch adjcommit
-		return True
-	remerge _ _ _ Nothing = return False
+	postmerge currbranch (Just mergecommit) = do
+		inRepo $ Git.Branch.update "updating original branch" origbranch mergecommit
+		adjtree <- adjustTree adj mergecommit
+		-- Make currbranch be a parent, so that merging
+		-- this commit will be a fast-forward.
+		adjmergecommit <- commitAdjustedTree' adjtree mergecommit
+			[mergecommit, currbranch]
+		showAction "Merging into adjusted branch"
+		ifM (autoMergeFrom adjmergecommit (Just currbranch) commitmode)
+			-- The adjusted branch has a merge commit on top;
+			-- clean that up and propigate any changes made
+			-- in that merge to the origbranch.
+			( do
+				propigateAdjustedCommits origbranch (adj, currbranch)
+				return True
+			, return False
+			)
+	postmerge _ Nothing = return False
 
 {- Check for any commits present on the adjusted branch that have not yet
  - been propigated to the orig branch, and propigate them.
@@ -308,16 +324,16 @@ updateAdjustedBranch tomerge (origbranch, adj) commitmode = catchBoolIO $
  -}
 propigateAdjustedCommits :: OrigBranch -> (Adjustment, AdjBranch) -> Annex ()
 propigateAdjustedCommits origbranch (adj, currbranch) = 
-	preventCommits $ \commitsprevented -> do
-		join $ propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
+	preventCommits $ \commitsprevented ->
+		join $ snd <$> propigateAdjustedCommits' origbranch (adj, currbranch) commitsprevented
 		
-{- Returns action which will rebase the adjusted branch on top of the
- - updated orig branch. -}
+{- Returns sha of updated orig branch, and action which will rebase
+ - the adjusted branch on top of the updated orig branch. -}
 propigateAdjustedCommits'
 	:: OrigBranch
 	-> (Adjustment, AdjBranch)
 	-> CommitsPrevented
-	-> Annex (Annex ())
+	-> Annex (Maybe Sha, Annex ())
 propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
 	ov <- inRepo $ Git.Ref.sha (Git.Ref.under "refs/heads" origbranch)
 	case ov of
@@ -329,11 +345,13 @@ propigateAdjustedCommits' origbranch (adj, currbranch) _commitsprevented = do
 					case v of
 						Left e -> do
 							warning e
-							return $ return ()
-						Right newparent -> return $
-							rebase currcommit newparent
-				Nothing -> return $ return ()
-		Nothing -> return $ return ()
+							return (Nothing, return ())
+						Right newparent -> return
+							( Just newparent
+							, rebase currcommit newparent
+							)
+				Nothing -> return (Nothing, return ())
+		Nothing -> return (Nothing, return ())
   where
 	newcommits = inRepo $ Git.Branch.changedCommits origbranch currbranch
 		-- Get commits oldest first, so they can be processed
diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index 32aef28a9..1e5800c21 100644
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -35,7 +35,7 @@ import Control.Concurrent (threadDelay)
 import Annex.Common
 import Annex.BranchState
 import Annex.Journal
-import Annex.Index
+import Annex.GitOverlay
 import qualified Git
 import qualified Git.Command
 import qualified Git.Ref
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index d16692226..cd0835f04 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -37,7 +37,7 @@ import Annex.Perms
 import Annex.ReplaceFile
 import Annex.VariantFile
 import Git.Index
-import Annex.Index
+import Annex.GitOverlay
 import Annex.LockFile
 import Annex.InodeSentinal
 
diff --git a/Annex/GitOverlay.hs b/Annex/GitOverlay.hs
new file mode 100644
index 000000000..b6b1398f4
--- /dev/null
+++ b/Annex/GitOverlay.hs
@@ -0,0 +1,63 @@
+{- Temporarily changing the files git uses.
+ -
+ - Copyright 2014-2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Annex.GitOverlay where
+
+import qualified Control.Exception as E
+
+import Annex.Common
+import Git
+import Git.Types
+import Git.Env
+import qualified Annex
+
+{- Runs an action using a different git index file. -}
+withIndexFile :: FilePath -> Annex a -> Annex a
+withIndexFile f = withAltRepo
+	(\g -> addGitEnv g "GIT_INDEX_FILE" f)
+	(\g g' -> g' { gitEnv = gitEnv g })
+
+{- Runs an action using a different git work tree. -}
+withWorkTree :: FilePath -> Annex a -> Annex a
+withWorkTree d = withAltRepo
+	(\g -> return $ g { location = modlocation (location g) })
+	(\g g' -> g' { location = location g })
+  where
+	modlocation l@(Local {}) = l { worktree = Just d }
+	modlocation _ = error "withWorkTree of non-local git repo"
+
+{- Runs an action with the git index file and HEAD, and a few other
+ - files that are related to the work tree coming from an overlay
+ - directory other than the usual. This is done by pointing
+ - GIT_COMMON_DIR at the regular git directory, and GIT_DIR at the
+ - overlay directory. -}
+withWorkTreeRelated :: FilePath -> Annex a -> Annex a
+withWorkTreeRelated d = withAltRepo modrepo unmodrepo
+  where
+	modrepo g = do
+		let g' = g { location = modlocation (location g) }
+		addGitEnv g' "GIT_COMMON_DIR" =<< absPath (localGitDir g)
+	unmodrepo g g' = g' { gitEnv = gitEnv g, location = location g }
+	modlocation l@(Local {}) = l { gitdir = d }
+	modlocation _ = error "withWorkTreeRelated of non-local git repo"
+
+withAltRepo 
+	:: (Repo -> IO Repo)
+	-- ^ modify Repo
+	-> (Repo -> Repo -> Repo)
+	-- ^ undo modifications; first Repo is the original and second
+	-- is the one after running the action.
+	-> Annex a
+	-> Annex a
+withAltRepo modrepo unmodrepo a = do
+	g <- gitRepo
+	g' <- liftIO $ modrepo g
+	r <- tryNonAsync $ do
+		Annex.changeState $ \s -> s { Annex.repo = g' }
+		a
+	Annex.changeState $ \s -> s { Annex.repo = unmodrepo g (Annex.repo s) }
+	either E.throw return r
diff --git a/Annex/Index.hs b/Annex/Index.hs
deleted file mode 100644
index b3323ff3a..000000000
--- a/Annex/Index.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-{- Using other git index files
- -
- - Copyright 2014 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Annex.Index (withIndexFile) where
-
-import qualified Control.Exception as E
-
-import Annex.Common
-import Git.Types
-import Git.Env
-import qualified Annex
-
-{- Runs an action using a different git index file. -}
-withIndexFile :: FilePath -> Annex a -> Annex a
-withIndexFile f a = do
-	g <- gitRepo
-	g' <- liftIO $ addGitEnv g "GIT_INDEX_FILE" f
-
-	r <- tryNonAsync $ do
-		Annex.changeState $ \s -> s { Annex.repo = g' }
-		a
-	Annex.changeState $ \s -> s { Annex.repo = (Annex.repo s) { gitEnv = gitEnv g} }
-	either E.throw return r
diff --git a/Annex/Locations.hs b/Annex/Locations.hs
index 4c2816fa9..52753fca8 100644
--- a/Annex/Locations.hs
+++ b/Annex/Locations.hs
@@ -291,7 +291,8 @@ gitAnnexFeedStateDir r = addTrailingPathSeparator $ gitAnnexDir r </> "feedstate
 gitAnnexFeedState :: Key -> Git.Repo -> FilePath
 gitAnnexFeedState k r = gitAnnexFeedStateDir r </> keyFile k
 
-{- .git/annex/merge/ is used for direct mode merges. -}
+{- .git/annex/merge/ is used as a empty work tree for direct mode merges and
+ - merges in adjusted branches. -}
 gitAnnexMergeDir :: Git.Repo -> FilePath
 gitAnnexMergeDir r = addTrailingPathSeparator $ gitAnnexDir r </> "merge"
 
diff --git a/Annex/View.hs b/Annex/View.hs
index 0078c2cad..3f8f8ad17 100644
--- a/Annex/View.hs
+++ b/Annex/View.hs
@@ -23,7 +23,7 @@ import Annex.HashObject
 import Git.Types
 import Git.FilePath
 import Annex.WorkTree
-import Annex.Index
+import Annex.GitOverlay
 import Annex.Link
 import Annex.CatFile
 import Logs.MetaData