direct mode merging works!

Automatic merge resoltion code needs to be fixed to preserve objects from
direct mode files.

2 files changed, 95 insertions, 23 deletions

diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
index 66aa2e9d5..5e33a8951 100644
--- a/Annex/Content/Direct.hs
+++ b/Annex/Content/Direct.hs
@@ -9,7 +9,6 @@ module Annex.Content.Direct (
 	associatedFiles,
 	removeAssociatedFile,
 	addAssociatedFile,
-	updateAssociatedFiles,
 	goodContent,
 	updateCache,
 	recordedCache,
@@ -23,11 +22,7 @@ module Annex.Content.Direct (
 
 import Common.Annex
 import qualified Git
-import qualified Git.DiffTree as DiffTree
-import Git.Sha
-import Annex.CatFile
 import Utility.TempFile
-import Utility.FileMode
 import Logs.Location
 
 import System.Posix.Types
@@ -70,23 +65,6 @@ addAssociatedFile key file = changeAssociatedFiles key $ \files ->
 		then files
 		else file:files
 
-{- Uses git diff-tree to find files changed between two tree Shas, and
- - updates the associated file mappings, efficiently. -}
-updateAssociatedFiles :: Git.Sha -> Git.Sha -> Annex ()
-updateAssociatedFiles oldsha newsha = do
-	(items, cleanup) <- inRepo $ DiffTree.diffTree oldsha newsha
-	forM_ items update
-	void $ liftIO $ cleanup
-  where
-	update item = do
-		go DiffTree.dstsha DiffTree.dstmode addAssociatedFile
-		go DiffTree.srcsha DiffTree.srcmode removeAssociatedFile
-	  where
-		go getsha getmode a =
-			when (getsha item /= nullSha && isSymLink (getmode item)) $ do
-				key <- catKey (getsha item)
-				maybe noop (\k -> void $ a k $ DiffTree.file item) key
-
 {- Checks if a file in the tree, associated with a key, has not been modified.
  -
  - To avoid needing to fsck the file's content, which can involve an
diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index 12984687e..ad67ee990 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -12,9 +12,13 @@ import qualified Git
 import qualified Git.LsFiles
 import qualified Git.UpdateIndex
 import qualified Git.HashObject
-import qualified Annex.Queue
+import qualified Git.Merge
+import qualified Git.DiffTree as DiffTree
+import Git.Sha
 import Git.Types
 import Annex.CatFile
+import Utility.FileMode
+import qualified Annex.Queue
 import Logs.Location
 import Backend
 import Types.KeySource
@@ -103,3 +107,93 @@ addDirect file cache = do
 			showEndFail
 			return False
 		)
+
+{- In direct mode, git merge would usually refuse to do anything, since it
+ - sees present direct mode files as type changed files. To avoid this,
+ - merge is run with the work tree set to a temp directory.
+ -
+ - This should only be used once any changes to the real working tree have
+ - already been committed, because it overwrites files in the working tree.
+ -}
+mergeDirect :: FilePath -> Git.Ref -> Git.Repo -> IO Bool
+mergeDirect d branch g = do
+	createDirectoryIfMissing True d
+	let g' = g { location = Local { gitdir = Git.localGitDir g, worktree = Just d } }
+	Git.Merge.mergeNonInteractive branch g'
+
+{- Cleans up after a direct mode merge. The merge must have been committed,
+ - and the commit sha passed in, along with the old sha of the tree
+ - before the merge. Uses git diff-tree to find files that changed between
+ - the two shas, and applies those changes to the work tree.
+ -}
+mergeDirectCleanup :: FilePath -> Git.Ref -> Git.Ref -> Annex ()
+mergeDirectCleanup d oldsha newsha = do
+	(items, cleanup) <- inRepo $ DiffTree.diffTreeRecursive oldsha newsha
+	forM_ items updated
+	void $ liftIO $ cleanup
+	liftIO $ removeDirectoryRecursive d
+  where
+	updated item = do
+		go DiffTree.srcsha DiffTree.srcmode moveout moveout_raw
+		go DiffTree.dstsha DiffTree.dstmode movein movein_raw
+	  where
+		go getsha getmode a araw
+			| getsha item == nullSha = noop
+			| isSymLink (getmode item) =
+				maybe (araw f) (\k -> void $ a k f)
+					=<< catKey (getsha item)
+			| otherwise = araw f
+		f = DiffTree.file item
+
+	{- Any content that was present in direct mode and whose file is to
+	 - be modified or deleted by the merge is first moved to
+	 - .git/annex/objects, unless there are other associated files for
+	 - the content. No content is ever lost due to a direct mode merge. -}
+	moveout k f = do
+		locs <- removeAssociatedFile k f
+		when (null locs) $ do
+			r <- liftIO $ catchMaybeIO $ getSymbolicLinkStatus f
+			case r of
+				Just s
+					| not (isSymbolicLink s) ->
+						moveAnnex k f
+				_ -> noop
+		moveout_raw f
+
+	{- Files deleted by the merge are removed from the work tree.
+	 - Empty work tree directories are removed, per git behavior. -}
+	moveout_raw f = liftIO $ do
+		nukeFile f
+		void $ catchMaybeIO $ removeDirectory $ parentDir f
+	
+	{- Key symlinks are replaced with their content, if it's available. -}
+	movein k f = do
+		movein_raw f
+		maybe noop id =<< toDirect k f
+	
+	{- Any new, modified, or renamed files were written to the temp
+	 - directory by the merge, and are moved to the real work tree. -}
+	movein_raw f = liftIO $ do
+		createDirectoryIfMissing True $ parentDir f
+		rename (d </> f) f
+
+{- If possible, returns an action that will convert a symlink in the
+ - working tree into a direct mode file. -}
+toDirect :: Key -> FilePath -> Annex (Maybe (Annex ()))
+toDirect k f = do
+	loc <- inRepo $ gitAnnexLocation k
+	createContentDir loc -- thaws directory too
+	locs <- filter (/= f) <$> addAssociatedFile k f
+	case locs of
+		[] -> ifM (liftIO $ doesFileExist loc)
+			( return $ Just $ do
+				{- Move content from annex to direct file. -}
+				updateCache k loc
+				thawContent loc
+				liftIO $ replaceFile f $ moveFile loc
+			, return Nothing
+			)
+		(loc':_) -> return $ Just $ do
+			{- Another direct file has the content, so
+			 - hard link to it. -}
+			liftIO $ replaceFile f $ createLink loc'