sync: Automatically resolves merge conflicts.

untested, but it compiles :)
This commit is contained in:
Joey Hess 2012-06-27 13:08:32 -04:00
parent 051c68041b
commit 048b64024a
5 changed files with 60 additions and 12 deletions

View file

@ -15,15 +15,21 @@ import Command
import qualified Remote import qualified Remote
import qualified Annex import qualified Annex
import qualified Annex.Branch import qualified Annex.Branch
import qualified Annex.Queue
import Annex.Content
import Annex.CatFile
import qualified Git.Command import qualified Git.Command
import qualified Git.LsFiles as LsFiles
import qualified Git.Merge import qualified Git.Merge
import qualified Git.Branch import qualified Git.Branch
import qualified Git.Ref import qualified Git.Ref
import qualified Git import qualified Git
import Git.Types (BlobType(..))
import qualified Types.Remote import qualified Types.Remote
import qualified Remote.Git import qualified Remote.Git
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.ByteString.Lazy as L
def :: [Command] def :: [Command]
def = [command "sync" (paramOptional (paramRepeating paramRemote)) def = [command "sync" (paramOptional (paramRepeating paramRemote))
@ -161,7 +167,11 @@ mergeFrom branch = do
ok <- inRepo $ Git.Merge.mergeNonInteractive branch ok <- inRepo $ Git.Merge.mergeNonInteractive branch
if ok if ok
then return ok then return ok
else resolveMerge else do
merged <- resolveMerge
when merged $
showNote "merge conflict automatically resolved"
return merged
{- Resolves a conflicted merge. It's important that any conflicts be {- Resolves a conflicted merge. It's important that any conflicts be
- resolved in a way that itself avoids later merge conflicts, since - resolved in a way that itself avoids later merge conflicts, since
@ -171,15 +181,48 @@ mergeFrom branch = do
- handle. - handle.
- -
- This uses the Keys pointed to by the files to construct new - This uses the Keys pointed to by the files to construct new
- filenames. So a conflicted merge of file foo will delete it, - filenames. So when both sides modified file foo,
- and add files foo.KEYA and foo.KEYB. - it will be deleted, and replaced with files foo.KEYA and foo.KEYB.
- -
- A conflict can also result due to - 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 :: Annex Bool
resolveMerge = do resolveMerge = do
top <- fromRepo Git.repoPath
all id <$> (mapM resolveMerge' =<< inRepo (LsFiles.unmerged [top]))
resolveMerge' :: LsFiles.Unmerged -> Annex Bool
resolveMerge' u
| issymlink LsFiles.valUs && issymlink LsFiles.valThem = do
keyUs <- getkey LsFiles.valUs
keyThem <- getkey LsFiles.valThem
if (keyUs == keyThem)
then makelink keyUs (file ++ "." ++ show keyUs)
else do
void $ liftIO $ tryIO $ removeFile file
Annex.Queue.addCommand "rm" [Params "--quiet -f --"] [file]
makelink keyUs (file ++ "." ++ show keyUs)
makelink keyThem (file ++ "." ++ show keyThem)
return True
| otherwise = return False
where
file = LsFiles.unmergedFile u
issymlink select = any (select (LsFiles.unmergedBlobType u) ==)
[Just SymlinkBlob, Nothing]
makelink (Just key) f = do
l <- calcGitLink file key
liftIO $ createSymbolicLink l f
Annex.Queue.addCommand "add" [Param "--force", Param "--"] [f]
makelink _ _ = noop
getkey select = do
let msha = select $ LsFiles.unmergedSha u
case msha of
Nothing -> return Nothing
Just sha -> fileKey . takeFileName
. encodeW8 . L.unpack <$> catObject sha
changed :: Remote -> Git.Ref -> Annex Bool changed :: Remote -> Git.Ref -> Annex Bool
changed remote b = do changed remote b = do
let r = remoteBranch remote b let r = remoteBranch remote b

View file

@ -88,9 +88,6 @@ data Conflicting v = Conflicting
, valThem :: Maybe v , valThem :: Maybe v
} deriving (Show) } deriving (Show)
isConflicting :: Eq a => Conflicting a -> Bool
isConflicting (Conflicting a b) = a /= b
data Unmerged = Unmerged data Unmerged = Unmerged
{ unmergedFile :: FilePath { unmergedFile :: FilePath
, unmergedBlobType :: Conflicting BlobType , unmergedBlobType :: Conflicting BlobType
@ -124,7 +121,7 @@ parseUnmerged :: String -> Maybe InternalUnmerged
parseUnmerged s parseUnmerged s
| null file || length ws < 3 = Nothing | null file || length ws < 3 = Nothing
| otherwise = do | otherwise = do
stage <- readish (ws !! 2) stage <- readish (ws !! 2) :: Maybe Int
unless (stage == 2 || stage == 3) $ unless (stage == 2 || stage == 3) $
fail undefined -- skip stage 1 fail undefined -- skip stage 1
blobtype <- readBlobType (ws !! 0) blobtype <- readBlobType (ws !! 0)
@ -148,9 +145,9 @@ reduceUnmerged c (i:is) = reduceUnmerged (new:c) rest
, unmergedSha = Conflicting shaA shaB , unmergedSha = Conflicting shaA shaB
} }
findsib templatei [] = ([], deleted templatei) findsib templatei [] = ([], deleted templatei)
findsib templatei (i:is) findsib templatei (l:ls)
| ifile i == ifile templatei = (is, i) | ifile l == ifile templatei = (ls, l)
| otherwise = (i:is, deleted templatei) | otherwise = (l:ls, deleted templatei)
deleted templatei = templatei deleted templatei = templatei
{ isus = not (isus templatei) { isus = not (isus templatei)
, iblobtype = Nothing , iblobtype = Nothing

View file

@ -51,6 +51,7 @@ type Tag = Ref
{- Types of objects that can be stored in git. -} {- Types of objects that can be stored in git. -}
data ObjectType = BlobObject | CommitObject | TreeObject data ObjectType = BlobObject | CommitObject | TreeObject
deriving (Eq)
instance Show ObjectType where instance Show ObjectType where
show BlobObject = "blob" show BlobObject = "blob"
@ -65,6 +66,7 @@ readObjectType _ = Nothing
{- Types of blobs. -} {- Types of blobs. -}
data BlobType = FileBlob | ExecutableBlob | SymlinkBlob data BlobType = FileBlob | ExecutableBlob | SymlinkBlob
deriving (Eq)
{- Git uses magic numbers to denote the type of a blob. -} {- Git uses magic numbers to denote the type of a blob. -}
instance Show BlobType where instance Show BlobType where

1
debian/changelog vendored
View file

@ -9,6 +9,7 @@ git-annex (3.20120625) UNRELEASED; urgency=low
* Accept arbitrarily encoded repository filepaths etc when reading * Accept arbitrarily encoded repository filepaths etc when reading
git config output. This fixes support for remotes with unusual characters git config output. This fixes support for remotes with unusual characters
in their names. in their names.
* sync: Automatically resolves merge conflicts.
-- Joey Hess <joeyh@debian.org> Mon, 25 Jun 2012 11:38:12 -0400 -- Joey Hess <joeyh@debian.org> Mon, 25 Jun 2012 11:38:12 -0400

View file

@ -135,6 +135,11 @@ subdirectories).
commands to do each of those steps by hand, or if you don't want to commands to do each of those steps by hand, or if you don't want to
worry about the details, you can use sync. worry about the details, you can use sync.
Merge conflicts are automatically resolved by sync. When two conflicting
versions of a file have been committed, both will be added to the tree,
under different filenames. For example, file "foo" would be replaced
with "foo.somekey" and "foo.otherkey".
Note that syncing with a remote will not update the remote's working Note that syncing with a remote will not update the remote's working
tree with changes made to the local repository. However, those changes tree with changes made to the local repository. However, those changes
are pushed to the remote, so can be merged into its working tree are pushed to the remote, so can be merged into its working tree