From 051c68041b5b7a58e7080403e389d0641691edfd Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Wed, 27 Jun 2012 12:09:01 -0400
Subject: properly handle deleted files when processing ls-files --unmerged

---
 Git/LsFiles.hs | 88 +++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 72 insertions(+), 16 deletions(-)

(limited to 'Git/LsFiles.hs')

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
+			}
-- 
cgit v1.2.3