direct mode merging works!

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

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'