summaryrefslogtreecommitdiff
path: root/Command/Sync.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2014-03-04 15:00:19 -0400
committerGravatar Joey Hess <joey@kitenet.net>2014-03-04 15:00:19 -0400
commit05a1f05d157d1b18a8dadd7a6b08991da8e7cdc4 (patch)
tree75e8e61ea0771e7a7e2a25cb1876005f0623e1be /Command/Sync.hs
parent647d74a3e8463623e73de840eed2aca22a04842a (diff)
improved direct mode dir/file conflicted merge resultion, using tree grafting
Diffstat (limited to 'Command/Sync.hs')
-rw-r--r--Command/Sync.hs34
1 files changed, 12 insertions, 22 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 22a6b6f4d..838e40f48 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -21,6 +21,7 @@ import Annex.Link
import Annex.Hook
import qualified Git.Command
import qualified Git.LsFiles as LsFiles
+import qualified Git.UpdateIndex as UpdateIndex
import qualified Git.Merge
import qualified Git.Branch
import qualified Git.Ref
@@ -314,11 +315,11 @@ mergeFrom branch = do
, go
)
where
- go = inRepo (Git.Merge.mergeNonInteractive branch) <||> resolveMerge
+ go = inRepo (Git.Merge.mergeNonInteractive branch) <||> resolveMerge branch
godirect currbranch = do
old <- inRepo $ Git.Ref.sha currbranch
d <- fromRepo gitAnnexMergeDir
- r <- inRepo (mergeDirect d branch) <||> resolveMerge
+ r <- inRepo (mergeDirect d branch) <||> resolveMerge branch
new <- inRepo $ Git.Ref.sha currbranch
case (old, new) of
(Just oldsha, Just newsha) ->
@@ -352,11 +353,11 @@ mergeFrom branch = do
- staged to the index, and written to the gitAnnexMergeDir, and later
- mergeDirectCleanup handles updating the work tree.
-}
-resolveMerge :: Annex Bool
-resolveMerge = do
+resolveMerge :: Git.Ref -> Annex Bool
+resolveMerge branch = do
top <- fromRepo Git.repoPath
(fs, cleanup) <- inRepo (LsFiles.unmerged [top])
- mergedfs <- catMaybes <$> mapM resolveMerge' fs
+ mergedfs <- catMaybes <$> mapM (resolveMerge' branch) fs
let merged = not (null mergedfs)
void $ liftIO cleanup
@@ -378,8 +379,8 @@ resolveMerge = do
showLongNote "Merge conflict was automatically resolved; you may want to examine the result."
return merged
-resolveMerge' :: LsFiles.Unmerged -> Annex (Maybe FilePath)
-resolveMerge' u
+resolveMerge' :: Git.Ref -> LsFiles.Unmerged -> Annex (Maybe FilePath)
+resolveMerge' branch u
| mergeable LsFiles.valUs && mergeable LsFiles.valThem = do
kus <- getKey LsFiles.valUs
kthem <- getKey LsFiles.valThem
@@ -429,21 +430,10 @@ resolveMerge' u
-- removing the conflicted file from cache clears the conflict
unstageoldfile = Annex.Queue.addCommand "rm" [Params "--quiet -f --cached --"] [file]
- {- stage an item from the direct mode merge directory -}
- stagefromdirectmergedir item = do
- d <- fromRepo gitAnnexMergeDir
- l <- liftIO $ dirContentsRecursive (d </> item)
- if null l
- then go d (d </> item)
- else mapM_ (go d) l
- where
- go d f = do
- v <- getAnnexLinkTarget f
- let worktreef = makeRelative d f
- case v of
- Just target -> stageSymlink worktreef
- =<< hashSymlink target
- Nothing -> noop
+ {- stage an item from the direct mode merge directory, which may
+ - be a directory with arbitrary contents -}
+ stagefromdirectmergedir item = Annex.Queue.addUpdateIndex
+ =<< fromRepo (UpdateIndex.lsSubTree branch item)
{- git-merge moves conflicting files away to files
- named something like f~HEAD or f~branch, but the