diff options
| -rw-r--r-- | Command/Sync.hs | 34 | ||||
| -rw-r--r-- | Git/UpdateIndex.hs | 8 |
2 files changed, 20 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 diff --git a/Git/UpdateIndex.hs b/Git/UpdateIndex.hs index 6d1ff2548..4ecd77363 100644 --- a/Git/UpdateIndex.hs +++ b/Git/UpdateIndex.hs @@ -15,6 +15,7 @@ module Git.UpdateIndex ( startUpdateIndex, stopUpdateIndex, lsTree, + lsSubTree, updateIndexLine, stageFile, unstageFile, @@ -74,6 +75,13 @@ lsTree (Ref x) repo streamer = do void $ cleanup where params = map Param ["ls-tree", "-z", "-r", "--full-tree", x] +lsSubTree :: Ref -> FilePath -> Repo -> Streamer +lsSubTree (Ref x) p repo streamer = do + (s, cleanup) <- pipeNullSplit params repo + mapM_ streamer s + void $ cleanup + where + params = map Param ["ls-tree", "-z", "-r", "--full-tree", x, p] {- Generates a line suitable to be fed into update-index, to add - a given file with a given sha. -} |