summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-27 13:08:32 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-27 13:08:32 -0400
commit048b64024a14feb0d9ed26abe97c542cfacbc8af (patch)
treeff17714706a56f2af7b7ef8f550070344fd6b0ff /Command
parent051c68041b5b7a58e7080403e389d0641691edfd (diff)
sync: Automatically resolves merge conflicts.
untested, but it compiles :)
Diffstat (limited to 'Command')
-rw-r--r--Command/Sync.hs55
1 files changed, 49 insertions, 6 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 2f3863617..a39a2e57f 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -15,15 +15,21 @@ 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
def :: [Command]
def = [command "sync" (paramOptional (paramRepeating paramRemote))
@@ -161,7 +167,11 @@ mergeFrom branch = do
ok <- inRepo $ Git.Merge.mergeNonInteractive branch
if 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
- resolved in a way that itself avoids later merge conflicts, since
@@ -171,15 +181,48 @@ mergeFrom branch = do
- 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.
+ - filenames. So when both sides modified file foo,
+ - 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 = 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 b = do
let r = remoteBranch remote b