finish fixing direct mode merge bug involving unstaged local files

Added test cases for both ways this can happen, with a conflict involving a
file, or a directory.

Cleaned up resolveMerge to not touch the work tree in direct mode, which
turned out to be the only way to handle things.. And makes it much nicer.

Still need to run test suite on windows.

Annex/Direct.hs

@@ -170,23 +170,23 @@ mergeDirectCleanup d oldsha newsha = do
 	makeabs <- flip fromTopFilePath <$> gitRepo
 	let fsitems = zip (map (makeabs . DiffTree.file) items) items
 	forM_ fsitems $
-		go DiffTree.srcsha DiffTree.srcmode moveout moveout_raw
+		go makeabs DiffTree.srcsha DiffTree.srcmode moveout moveout_raw
 	forM_ fsitems $
-		go DiffTree.dstsha DiffTree.dstmode movein movein_raw
+		go makeabs DiffTree.dstsha DiffTree.dstmode movein movein_raw
 	void $ liftIO cleanup
 	liftIO $ removeDirectoryRecursive d
   where
-	go getsha getmode a araw (f, item)
+	go makeabs getsha getmode a araw (f, item)
 		| getsha item == nullSha = noop
 		| otherwise = void $
-			tryAnnex . maybe (araw f item) (\k -> void $ a k f)
+			tryAnnex . maybe (araw item makeabs f) (\k -> void $ a item makeabs k f)
 				=<< catKey (getsha item) (getmode item)
 
-	moveout = removeDirect
+	moveout _ _ = removeDirect
 
 	{- Files deleted by the merge are removed from the work tree.
 	 - Empty work tree directories are removed, per git behavior. -}
-	moveout_raw f _item = liftIO $ do
+	moveout_raw _ _ f = liftIO $ do
 		nukeFile f
 		void $ tryIO $ removeDirectory $ parentDir f
 	
@@ -198,39 +198,60 @@ mergeDirectCleanup d oldsha newsha = do
 	 -
 	 - Otherwise, create the symlink and then if possible, replace it
 	 - with the content. -}
-	movein k f = unlessM (goodContent k f) $ do
+	movein item makeabs k f = unlessM (goodContent k f) $ do
-		preserveUnannexed f
+		preserveUnannexed item makeabs f oldsha
 		l <- inRepo $ gitAnnexLink f k
 		replaceFile f $ makeAnnexLink l
 		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 item = do
+	movein_raw item makeabs f = do
-		preserveUnannexed f
+		preserveUnannexed item makeabs f oldsha
 		liftIO $ do
 			createDirectoryIfMissing True $ parentDir f
 			void $ tryIO $ rename (d </> getTopFilePath (DiffTree.file item)) f
 
-	{- If the file is present in the work tree, but did not exist in
+{- If the file that's being moved in is already present in the work
-	 - the oldsha branch, preserve this local, unannexed file. -}
+ - tree, but did not exist in the oldsha branch, preserve this
-	preserveUnannexed f = whenM unannexed $
+ - local, unannexed file (or directory), as "variant-local".
-		whenM (isNothing <$> catFileDetails oldsha f) $
+ -
-			liftIO $ findnewname (0 :: Int)
+ - It's also possible that the file that's being moved in
-	  where
+ - is in a directory that collides with an exsting, non-annexed
-		exists = isJust <$$> catchMaybeIO . getSymbolicLinkStatus
+ - file (not a directory), which should be preserved.
+ -}
+preserveUnannexed :: DiffTree.DiffTreeItem -> (TopFilePath -> FilePath) -> FilePath -> Ref -> Annex ()
+preserveUnannexed item makeabs absf oldsha = do
+	whenM (liftIO (collidingitem absf) <&&> unannexed absf) $
+		liftIO $ findnewname absf 0
+	checkdirs (DiffTree.file item)
+  where
+	checkdirs from = do
+		let p = parentDir (getTopFilePath from)
+		let d = asTopFilePath p
+		unless (null p) $ do
+			let absd = makeabs d
+			whenM (liftIO (colliding_nondir absd) <&&> unannexed absd) $
+				liftIO $ findnewname absd 0
+			checkdirs d
+			
+	collidingitem f = isJust
+		<$> catchMaybeIO (getSymbolicLinkStatus f)
+	colliding_nondir f = maybe False (not . isDirectory)
+		<$> catchMaybeIO (getSymbolicLinkStatus f)
 
-		unannexed = liftIO (exists f)
+	unannexed f = (isNothing <$> isAnnexLink f)
-			<&&> (isNothing <$> isAnnexLink f)
+		<&&> (isNothing <$> catFileDetails oldsha f)
 
-		findnewname n = do
+	findnewname :: FilePath -> Int -> IO ()
-			let localf = mkVariant f 
+	findnewname f n = do
-				("local" ++ if n > 0 then show n else "")
+		let localf = mkVariant f 
-			ifM (exists localf)
+			("local" ++ if n > 0 then show n else "")
-				( findnewname (n+1)
+		ifM (collidingitem localf)
-				, rename f localf
+			( findnewname f (n+1)
-					`catchIO` const (findnewname (n+1))
+			, rename f localf
-				)
+				`catchIO` const (findnewname f (n+1))
+			)
 
 {- If possible, converts a symlink in the working tree into a direct
  - mode file. If the content is not available, leaves the symlink

Command/Sync.hs

@@ -345,6 +345,12 @@ mergeFrom branch = do
  - It's also possible that one side has foo as an annexed file, and
  - the other as a directory or non-annexed file. The annexed file
  - is renamed to resolve the merge, and the other object is preserved as-is.
+ -
+ - In indirect mode, the merge is resolved in the work tree and files
+ - staged, to clean up from a conflicted merge that was run in the work
+ - tree. In direct mode, the work tree is not touched here; files are 
+ - staged to the index, and written to the gitAnnexMergeDir, and later
+ - mergeDirectCleanup handles updating the work tree.
  -}
 resolveMerge :: Annex Bool
 resolveMerge = do
@@ -354,10 +360,11 @@ resolveMerge = do
 	let merged = not (null mergedfs)
 	void $ liftIO cleanup
 
-	(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])
+	unlessM isDirect $ do
-	unless (null deleted) $
+		(deleted, cleanup2) <- inRepo (LsFiles.deleted [top])
-		Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted
+		unless (null deleted) $
-	void $ liftIO cleanup2
+			Annex.Queue.addCommand "rm" [Params "--quiet -f --"] deleted
+		void $ liftIO cleanup2
 
 	when merged $ do
 		unlessM isDirect $
@@ -379,7 +386,7 @@ resolveMerge' u
 		case (kus, kthem) of
 			-- Both sides of conflict are annexed files
 			(Just keyUs, Just keyThem) -> do
-				removeoldfile keyUs
+				unstageoldfile
 				if keyUs == keyThem
 					then makelink keyUs
 					else do
@@ -388,20 +395,15 @@ resolveMerge' u
 				return $ Just file
 			-- Our side is annexed, other side is not.
 			(Just keyUs, Nothing) -> do
-				ifM isDirect
+				unstageoldfile
-					( do
+				whenM isDirect $
-						removeoldfile keyUs
+					stagefromdirectmergedir file
-						makelink keyUs
+				makelink keyUs
-						movefromdirectmerge file
-					, do
-						unstageoldfile
-						makelink keyUs
-					)
 				return $ Just file
 			-- Our side is not annexed, other side is.
 			(Nothing, Just keyThem) -> do
-				makelink keyThem
 				unstageoldfile
+				makelink keyThem
 				return $ Just file
 			-- Neither side is annexed; cannot resolve.
 			(Nothing, Nothing) -> return Nothing
@@ -413,45 +415,34 @@ resolveMerge' u
 	makelink key = do
 		let dest = variantFile file key
 		l <- inRepo $ gitAnnexLink dest key
-		replaceFile dest $ makeAnnexLink l
-		stageSymlink dest =<< hashSymlink l
-		whenM isDirect $
-			toDirect key dest
-	removeoldfile keyUs = do
 		ifM isDirect
-			( removeDirect keyUs file
+			( do
-			, liftIO $ nukeFile file
+				d <- fromRepo gitAnnexMergeDir
+				replaceFile (d </> dest) $ makeAnnexLink l
+			, replaceFile dest $ makeAnnexLink l
 			)
-		Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
+		stageSymlink dest =<< hashSymlink l
-	unstageoldfile = Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]
 	getKey select = case select (LsFiles.unmergedSha u) of
 		Nothing -> return Nothing
 		Just sha -> catKey sha symLinkMode
-	
+
-	{- Move something out of the direct mode merge directory and into
+	-- removing the conflicted file from cache clears the conflict
-	 - the git work tree.
+	unstageoldfile = Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]
-	 -
+
-	 - On a filesystem not supporting symlinks, this is complicated
+	{- stage an item from the direct mode merge directory -}
-	 - because a directory may contain annex links, but just
+	stagefromdirectmergedir item = do
-	 - moving them into the work tree will not let git know they are
-	 - symlinks.
-	 -
-	 - Also, if the content of the file is available, make it available
-	 - in direct mode.
-	 -}
-	movefromdirectmerge item = do
 		d <- fromRepo gitAnnexMergeDir
-		liftIO $ rename (d </> item) item
+		l <- liftIO $ dirContentsRecursive (d </> item)
-		mapM_ setuplink =<< liftIO (dirContentsRecursive item)
+		if null l
-	setuplink f = do
+			then go (d </> item)
-		v <- getAnnexLinkTarget f
+			else mapM_ go l
-		case v of
+	  where
-			Nothing -> noop
+	  	go f = do
-			Just target -> do
+			v <- getAnnexLinkTarget f
-				unlessM (coreSymlinks <$> Annex.getGitConfig) $
+			case v of
-					addAnnexLink target f
+				Just target -> stageSymlink f
-				maybe noop (`toDirect` f) 
+					=<< hashSymlink target
-					(fileKey (takeFileName target))
+				Nothing -> noop
 
 {- git-merge moves conflicting files away to files
  - named something like f~HEAD or f~branch, but the

debian/changelog

@@ -1,8 +1,8 @@
 git-annex (5.20140228) UNRELEASED; urgency=medium
 
-  * sync: Fix bug in direct mode that caused a file not checked into git
+  * sync: Fix bug in direct mode that caused a file that was not
-    to be deleted when merging with a remote that added a file by the same
+    checked into git to be deleted when there was a conflicting
-    name.
+    merge with a remote.
   * webapp: Now supports HTTPS.
   * webapp: No longer supports a port specified after --listen, since
     it was buggy, and that use case is better supported by setting up HTTPS.

doc/bugs/direct_mode_merge_can_overwrite_local__44___non-annexed_files.mdwn

@@ -10,3 +10,5 @@ is not checked into git, the merge will overwrite it with the remote file from g
 New problem: If the merge pulls in a directory, and a file exists with
 the name of the directory, locally, not annexed, the file is left alone,
 but the directory is thus not checked out, and will be deleted on commit.
+
+> [[fixed|done]]; regression test in place. --[[Joey]]