summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-27 12:09:01 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-27 12:11:03 -0400
commit051c68041b5b7a58e7080403e389d0641691edfd (patch)
tree8539a1a7e48d8767397a5df97a076e431f215bb5
parent8e8439a5191e8768edebdcf27668157b70c0ebf7 (diff)
properly handle deleted files when processing ls-files --unmerged
-rw-r--r--Command/Sync.hs24
-rw-r--r--Git/LsFiles.hs88
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
+ }