properly handle deleted files when processing ls-files --unmerged

2 files changed, 94 insertions, 18 deletions

diff --git a/Command/Sync.hs b/Command/Sync.hs
index 1da6b0b81..2f3863617 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -155,10 +155,30 @@ mergeAnnex = do
 	Annex.Branch.forceUpdate
 	stop
 
-mergeFrom :: Git.Ref -> CommandCleanup
+mergeFrom :: Git.Ref -> Annex Bool
 mergeFrom branch = do
 	showOutput
-	inRepo $ Git.Merge.mergeNonInteractive branch
+	ok <- inRepo $ Git.Merge.mergeNonInteractive branch
+	if ok
+		then return ok
+		else resolveMerge
+
+{- Resolves a conflicted merge. It's important that any conflicts be
+ - resolved in a way that itself avoids later merge conflicts, since
+ - multiple repositories may be doing this concurrently.
+ -
+ - Only annexed files are resolved; other files are left for the user to
+ - handle.
+ -
+ - This uses the Keys pointed to by the files to construct new
+ - filenames. So a conflicted merge of file foo will delete it,
+ - and add files foo.KEYA and foo.KEYB. 
+ -
+ - A conflict can also result due to 
+ -}
+resolveMerge :: Annex Bool
+resolveMerge = do
+	
 
 changed :: Remote -> Git.Ref -> Annex Bool
 changed remote b = do
diff --git a/Git/LsFiles.hs b/Git/LsFiles.hs
index 540503a28..ce7c84aee 100644
--- a/Git/LsFiles.hs
+++ b/Git/LsFiles.hs
@@ -13,6 +13,9 @@ module Git.LsFiles (
 	changedUnstaged,
 	typeChanged,
 	typeChangedStaged,
+	Conflicting(..),
+	Unmerged(..),
+	unmerged,
 ) where
 
 import Common
@@ -78,25 +81,78 @@ typeChanged' ps l repo = do
 		prefix = [Params "diff --name-only --diff-filter=T -z"]
 		suffix = Param "--" : map File l
 
+{- A item in conflict has two possible values.
+ - Either can be Nothing, when that side deleted the file. -}
+data Conflicting v = Conflicting
+	{ valUs :: Maybe v
+	, valThem :: Maybe v
+	} deriving (Show)
+
+isConflicting :: Eq a => Conflicting a -> Bool
+isConflicting (Conflicting a b) = a /= b
+
 data Unmerged = Unmerged
 	{ unmergedFile :: FilePath
-	, unmergedBlobType :: BlobType
-	, unmergedSha :: Sha
-	}
+	, unmergedBlobType :: Conflicting BlobType
+	, unmergedSha :: Conflicting Sha
+	} deriving (Show)
 
 {- Returns a list of the files in the specified locations that have
- - unresolved merge conflicts. Each unmerged file will have duplicates
- - in the list for each unmerged version (typically two). -}
+ - unresolved merge conflicts.
+ -
+ - ls-files outputs multiple lines per conflicting file, each with its own
+ - stage number:
+ -   1 = old version, can be ignored
+ -   2 = us
+ -   3 = them
+ - If a line is omitted, that side deleted the file.
+ -}
 unmerged :: [FilePath] -> Repo -> IO [Unmerged]
-unmerged l repo = catMaybes . map parse <$> list repo
+unmerged l repo = reduceUnmerged [] . catMaybes . map parseUnmerged <$> list repo
+	where
+		files = map File l
+		list = pipeNullSplit $ Params "ls-files --unmerged -z --" : files
+
+data InternalUnmerged = InternalUnmerged
+	{ isus :: Bool
+	, ifile :: FilePath
+	, iblobtype :: Maybe BlobType
+	, isha :: Maybe Sha
+	} deriving (Show)
+
+parseUnmerged :: String -> Maybe InternalUnmerged
+parseUnmerged s
+	| null file || length ws < 3 = Nothing
+	| otherwise = do
+		stage <- readish (ws !! 2)
+		unless (stage == 2 || stage == 3) $
+			fail undefined -- skip stage 1
+		blobtype <- readBlobType (ws !! 0)
+		sha <- extractSha (ws !! 1)
+		return $ InternalUnmerged (stage == 2) file (Just blobtype) (Just sha)
+	where
+		(metadata, file) = separate (== '\t') s
+		ws = words metadata
+
+reduceUnmerged :: [Unmerged] -> [InternalUnmerged] -> [Unmerged]
+reduceUnmerged c [] = c
+reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
 	where
-		list = pipeNullSplit $ Params "ls-files --unmerged -z --" : map File l
-		parse s
-			| null file || length ws < 2 = Nothing
-			| otherwise = do
-				blobtype <- readBlobType (ws !! 0)
-				sha <- extractSha (ws !! 1)
-				return $ Unmerged file blobtype sha
-			where
-				(metadata, file) = separate (== '\t') s
-				ws = words metadata
+		(rest, sibi) = findsib i is
+		(blobtypeA, blobtypeB, shaA, shaB)
+			| isus i    = (iblobtype i, iblobtype sibi, isha i, isha sibi)
+			| otherwise = (iblobtype sibi, iblobtype i, isha sibi, isha i)
+		new = Unmerged
+			{ unmergedFile = ifile i
+			, unmergedBlobType = Conflicting blobtypeA blobtypeB
+			, unmergedSha = Conflicting shaA shaB
+			}
+		findsib templatei [] = ([], deleted templatei)
+		findsib templatei (i:is)
+			| ifile i == ifile templatei = (is, i)
+			| otherwise = (i:is, deleted templatei)
+		deleted templatei = templatei
+			{ isus = not (isus templatei)
+			, iblobtype = Nothing
+			, isha = Nothing
+			}