Merge branch 'master' into assistant

This commit is contained in:
Joey Hess 2012-06-27 16:14:33 -04:00
commit 8baff14054
14 changed files with 307 additions and 7 deletions

View file

@ -15,15 +15,22 @@ import Command
import qualified Remote
import qualified Annex
import qualified Annex.Branch
import qualified Annex.Queue
import Annex.Content
import Annex.CatFile
import qualified Git.Command
import qualified Git.LsFiles as LsFiles
import qualified Git.Merge
import qualified Git.Branch
import qualified Git.Ref
import qualified Git
import Git.Types (BlobType(..))
import qualified Types.Remote
import qualified Remote.Git
import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
import Data.Hash.MD5
def :: [Command]
def = [command "sync" (paramOptional (paramRepeating paramRemote))
@ -168,10 +175,104 @@ 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 when both sides modified file foo,
- it will be deleted, and replaced with files foo.KEYA and foo.KEYB.
-
- On the other hand, when one side deleted foo, and the other modified it,
- it will be deleted, and the modified version stored as file
- foo.KEYA (or KEYB).
-}
resolveMerge :: Annex Bool
resolveMerge = do
top <- fromRepo Git.repoPath
merged <- all id <$> (mapM resolveMerge' =<< inRepo (LsFiles.unmerged [top]))
when merged $ do
Annex.Queue.flush
void $ inRepo $ Git.Command.runBool "commit"
[Param "-m", Param "git-annex automatic merge conflict fix"]
return merged
resolveMerge' :: LsFiles.Unmerged -> Annex Bool
resolveMerge' u
| issymlink LsFiles.valUs && issymlink LsFiles.valThem =
withKey LsFiles.valUs $ \keyUs ->
withKey LsFiles.valThem $ \keyThem -> go keyUs keyThem
| otherwise = return False
where
go keyUs keyThem
| keyUs == keyThem = do
makelink keyUs
return True
| otherwise = do
liftIO $ nukeFile file
Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
makelink keyUs
makelink keyThem
return True
file = LsFiles.unmergedFile u
issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
[Just SymlinkBlob, Nothing]
makelink (Just key) = do
let dest = mergeFile file key
l <- calcGitLink dest key
liftIO $ do
nukeFile dest
createSymbolicLink l dest
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [dest]
makelink _ = noop
withKey select a = do
let msha = select $ LsFiles.unmergedSha u
case msha of
Nothing -> a Nothing
Just sha -> do
key <- fileKey . takeFileName
. encodeW8 . L.unpack
<$> catObject sha
maybe (return False) (a . Just) key
{- The filename to use when resolving a conflicted merge of a file,
- that points to a key.
-
- Something derived from the key needs to be included in the filename,
- but rather than exposing the whole key to the user, a very weak hash
- is used. There is a very real, although still unlikely, chance of
- conflicts using this hash.
-
- In the event that there is a conflict with the filename generated
- for some other key, that conflict will itself be handled by the
- conflicted merge resolution code. That case is detected, and the full
- key is used in the filename.
-}
mergeFile :: FilePath -> Key -> FilePath
mergeFile file key
| doubleconflict = go $ show key
| otherwise = go $ shortHash $ show key
where
varmarker = ".variant-"
doubleconflict = vermarker `isSuffixOf` (dropExtension file)
go v = takeDirectory file
</> dropExtension (takeFileName file)
++ varmarker ++ v
++ takeExtension file
shortHash :: String -> String
shortHash = take 4 . md5s . encodeFilePath
changed :: Remote -> Git.Ref -> Annex Bool
changed remote b = do