From 0ee1141f30b188e5ef52125c163ff2cf80c661ee Mon Sep 17 00:00:00 2001
From: Joachim Breitner <mail@joachim-breitner.de>
Date: Thu, 29 Dec 2011 18:37:30 +0100
Subject: Implement branch-syncing in Command.Sync

as described in the previous commit to the documentation. The loggin UI
is not great yet.
---
 Command/Sync.hs | 117 ++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 83 insertions(+), 34 deletions(-)

(limited to 'Command/Sync.hs')

diff --git a/Command/Sync.hs b/Command/Sync.hs
index 36c4eeef0..a9089463d 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -9,20 +9,41 @@ module Command.Sync where
 
 import Common.Annex
 import Command
+import qualified Remote
 import qualified Annex.Branch
 import qualified Git.Command
 import qualified Git.Config
 import qualified Git.Ref
 import qualified Git
+import qualified Command.Merge
 
 import qualified Data.ByteString.Lazy.Char8 as L
 
 def :: [Command]
-def = [command "sync" paramPaths seek "synchronize local repository with remote"]
+def = [command "sync" (paramOptional (paramRepeating paramRemote))
+               [seek] "synchronize local repository with remote repositories"]
 
 -- syncing involves several operations, any of which can independantly fail
-seek :: [CommandSeek]
-seek = map withNothing [commit, pull, push]
+seek :: CommandSeek
+seek args = do
+    remotes <- if null args
+               then defaultSyncRemotes
+               else mapM Remote.byName args
+    branch <- currentBranch
+    showStart "syncing" $ "branch " ++ Git.Ref.describe branch ++ " with remote repositories " ++ intercalate "," (map Remote.name remotes)
+    showOutput
+    return $
+        [ commit
+        , mergeLocal branch
+        ] ++
+        [ fetch remote | remote <- remotes ] ++
+        [ mergeRemote remote branch | remote <- remotes ] ++
+        [ Command.Merge.start ] ++
+        [ pushLocal branch ] ++
+        [ pushRemote remote branch | remote <- remotes ]
+
+defaultSyncRemotes :: Annex [Remote.Remote Annex]
+defaultSyncRemotes = undefined
 
 commit :: CommandStart
 commit = do
@@ -31,44 +52,72 @@ commit = do
 		showOutput
 		-- Commit will fail when the tree is clean, so ignore failure.
 		_ <- inRepo $ Git.Command.runBool "commit"
-			[Param "-a", Param "-m", Param "sync"]
+			[Param "-a", Param "-m", Param "git-annex automatic sync"]
 		return True
 
-pull :: CommandStart
-pull = do
-	remote <- defaultRemote
-	showStart "pull" remote
+mergeLocal :: Git.Ref -> CommandStart
+mergeLocal branch =
+    mergeFromIfExists $ Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch
+
+pushLocal :: Git.Ref -> CommandStart
+pushLocal branch = do
+    let syncBranch = Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch
+    ex <- inRepo $ Git.Ref.exists syncBranch
+    if ex then do
+        showStart "updateing" $
+            Git.Ref.describe syncBranch ++
+            " to the state of " ++ Git.Ref.describe branch ++ "..."
+        next $ next $
+            inRepo $ Git.Command.runBool "branch" [Param "-f", Param (Git.Ref.describe syncBranch)]
+      else
+        return Nothing
+
+mergeFromIfExists :: Git.Ref -> CommandStart
+mergeFromIfExists fromBranch = do
+    ex <- inRepo $ Git.Ref.exists fromBranch
+    if ex then do
+        showStart "merging" $ Git.Ref.describe fromBranch ++ "..."
+        next $ next $
+            inRepo $ Git.Command.runBool "merge" [Param (show fromBranch)]
+      else do
+        showNote $ Git.Ref.describe fromBranch ++ " does not exist, not merging."
+        showOutput
+        return Nothing
+
+
+fetch :: Remote.Remote Annex -> CommandStart
+fetch remote = do
+	showStart "fetching from" (Remote.name remote)
 	next $ next $ do
 		showOutput
 		checkRemote remote
-		inRepo $ Git.Command.runBool "pull" [Param remote]
+		inRepo $ Git.Command.runBool "fetch" [Param (Remote.name remote)]
 
-push :: CommandStart
-push = do
-	remote <- defaultRemote
-	showStart "push" remote
-	next $ next $ do
-		Annex.Branch.update
-		showOutput
-		inRepo $ Git.Command.runBool "push" [Param remote, matchingbranches]
-	where
-		-- git push may be configured to not push matching
-		-- branches; this should ensure it always does.
-		matchingbranches = Param ":"
-
--- the remote defaults to origin when not configured
-defaultRemote :: Annex String
-defaultRemote = do
-	branch <- currentBranch
-	fromRepo $ Git.Config.get ("branch." ++ branch ++ ".remote") "origin"
-
-currentBranch :: Annex String
-currentBranch = Git.Ref.describe . Git.Ref . firstLine . L.unpack <$>
+mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
+mergeRemote remote branch =
+    mergeFromIfExists $ Git.Ref $ "refs/remotes/" ++ Remote.name remote ++ "/synced/" ++ Git.Ref.describe branch
+
+pushRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
+pushRemote remote branch = do
+    showStart "pushing to" (Remote.name remote)
+    let syncbranch = Git.Ref $ "refs/heads/synced/" ++ Git.Ref.describe branch
+    let syncbranchRemote = Git.Ref $ "refs/remotes/" ++ Remote.name remote ++ "/" ++ Git.Ref.describe syncbranch
+    let refspec = Git.Ref.describe branch ++ ":" ++ Git.Ref.describe syncbranch
+    ex <- inRepo $ Git.Ref.exists syncbranchRemote
+    next $ next $ do
+            showOutput
+            inRepo $ Git.Command.runBool "push" $
+                [ Param (Remote.name remote)
+                , Param (Git.Ref.describe Annex.Branch.name) ] ++ 
+                [ Param refspec | ex ]
+
+currentBranch :: Annex Git.Ref
+currentBranch = Git.Ref . firstLine . L.unpack <$>
 	inRepo (Git.Command.pipeRead [Param "symbolic-ref", Param "HEAD"])
 
-checkRemote :: String -> Annex ()
+checkRemote :: Remote.Remote Annex -> Annex ()
 checkRemote remote = do
 	remoteurl <- fromRepo $
-		Git.Config.get ("remote." ++ remote ++ ".url") ""
-	when (null remoteurl) $ do
-		error $ "No url is configured for the remote: " ++ remote
+		Git.Config.get ("remote." ++ Remote.name remote ++ ".url") ""
+	when (null remoteurl) $
+		error $ "No url is configured for the remote: " ++ Remote.name remote
-- 
cgit v1.2.3