partial and incomplete automatic merging in direct mode

Handles our file right, but not theirs.

3 files changed, 38 insertions, 24 deletions

diff --git a/Annex/Direct.hs b/Annex/Direct.hs
index ad67ee990..3846b0a9e 100644
--- a/Annex/Direct.hs
+++ b/Annex/Direct.hs
@@ -145,20 +145,7 @@ mergeDirectCleanup d oldsha newsha = do
 			| 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
+	moveout k f = removeDirect k f
 
 	{- Files deleted by the merge are removed from the work tree.
 	 - Empty work tree directories are removed, per git behavior. -}
@@ -168,19 +155,24 @@ mergeDirectCleanup d oldsha newsha = do
 	
 	{- Key symlinks are replaced with their content, if it's available. -}
 	movein k f = do
-		movein_raw f
-		maybe noop id =<< toDirect k f
+		l <- calcGitLink f k
+		liftIO $ replaceFile f $ const $
+			createSymbolicLink l f
+		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
+		void $ catchMaybeIO $ 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
+{- If possible, converts a symlink in the working tree into a direct
+ - mode file. -}
+toDirect :: Key -> FilePath -> Annex ()
+toDirect k f = maybe noop id =<< toDirectGen k f
+
+toDirectGen :: Key -> FilePath -> Annex (Maybe (Annex ()))
+toDirectGen k f = do
 	loc <- inRepo $ gitAnnexLocation k
 	createContentDir loc -- thaws directory too
 	locs <- filter (/= f) <$> addAssociatedFile k f
@@ -197,3 +189,18 @@ toDirect k f = do
 			{- Another direct file has the content, so
 			 - hard link to it. -}
 			liftIO $ replaceFile f $ createLink loc'
+
+{- Removes a direct mode file, while retaining its content. -}
+removeDirect :: Key -> FilePath -> Annex ()
+removeDirect 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
+	liftIO $ do
+		nukeFile f
+		void $ catchMaybeIO $ removeDirectory $ parentDir f
diff --git a/Command/Direct.hs b/Command/Direct.hs
index 991930c38..8e7f40145 100644
--- a/Command/Direct.hs
+++ b/Command/Direct.hs
@@ -41,7 +41,7 @@ perform = do
 	next cleanup
   where
 	go = whenAnnexed $ \f (k, _) -> do
-		r <- toDirect k f
+		r <- toDirectGen k f
 		case r of
 			Nothing -> noop
 			Just a -> do
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 2d1b2fb9c..d6736a616 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -15,6 +15,7 @@ import qualified Annex
 import qualified Annex.Branch
 import qualified Annex.Queue
 import Annex.Content
+import Annex.Content.Direct
 import Annex.Direct
 import Annex.CatFile
 import qualified Git.Command
@@ -234,7 +235,8 @@ resolveMerge' :: LsFiles.Unmerged -> Annex Bool
 resolveMerge' u
 	| issymlink LsFiles.valUs && issymlink LsFiles.valThem =
 		withKey LsFiles.valUs $ \keyUs ->
-		withKey LsFiles.valThem $ \keyThem -> go keyUs keyThem
+		withKey LsFiles.valThem $ \keyThem -> do
+			go keyUs keyThem
 	| otherwise = return False
   where
 	go keyUs keyThem
@@ -242,7 +244,10 @@ resolveMerge' u
 			makelink keyUs
 			return True
 		| otherwise = do
-			liftIO $ nukeFile file
+			ifM isDirect
+				( maybe noop (\k -> removeDirect k file) keyUs
+				, liftIO $ nukeFile file
+				)
 			Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
 			makelink keyUs
 			makelink keyThem
@@ -257,6 +262,8 @@ resolveMerge' u
 			nukeFile dest
 			createSymbolicLink l dest
 		Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest]
+		whenM (isDirect) $
+			toDirect key dest
 	makelink _ = noop
 	withKey select a = do
 		let msha = select $ LsFiles.unmergedSha u