message cleanup

Command/Sync.hs

@@ -29,30 +29,29 @@ def = [command "sync" (paramOptional (paramRepeating paramRemote))
 seek :: CommandSeek
 seek args = do
 	!branch <- currentBranch
-	remotes <- syncRemotes branch args
+	let syncbranch = Git.Ref.under "refs/heads/synced/" branch
-	showStart "syncing" $ "branch " ++ Git.Ref.describe branch ++ " with remote repositories " ++ intercalate "," (map Remote.name remotes)
+	remotes <- syncRemotes syncbranch args
-	showOutput
 	return $
 		[ commit
 		, mergeLocal branch
 		] ++
-		[ fetch remote | remote <- remotes ] ++
+		[ update remote branch | remote <- remotes ] ++
-		[ mergeRemote remote branch | remote <- remotes ] ++
 		[ mergeAnnex ] ++
-		[ pushLocal branch ] ++
+		[ pushLocal syncbranch ] ++
-		[ pushRemote remote branch | remote <- remotes ]
+		[ pushRemote remote branch syncbranch | remote <- remotes ]
 
 syncRemotes :: Git.Ref -> [String] -> Annex [Remote.Remote Annex]
 syncRemotes branch [] = defaultSyncRemotes branch
 syncRemotes _ rs = mapM Remote.byName rs
 
 defaultSyncRemotes :: Git.Ref -> Annex [Remote.Remote Annex]
-defaultSyncRemotes branch = mapM Remote.byName
+defaultSyncRemotes syncbranch = mapM Remote.byName
 		=<< process . L.unpack <$> inRepo showref
 	where
-		syncbranch = Git.Ref.under "refs/heads/synced/" branch
 		showref = Git.Command.pipeRead
-			[Param "show-ref", Param $ show $ Git.Ref.base syncbranch]
+			[ Param "show-ref"
+			, Param $ show $ Git.Ref.base syncbranch
+			]
 		process = map getRemoteName . filter isRemote .
 			map getBranchName . lines
 	        isRemote r = "refs/remotes/" `isPrefixOf` r
@@ -70,52 +69,54 @@ commit = do
 		return True
 
 mergeLocal :: Git.Ref -> CommandStart
-mergeLocal = mergeFromIfExists . Git.Ref.under "refs/heads/synced"
+mergeLocal branch = do
+	let mergebranch = Git.Ref.under "refs/heads/synced" branch
+	showStart "merge" $ Git.Ref.describe mergebranch
+	next $ next $ mergeFromIfExists mergebranch
 
 pushLocal :: Git.Ref -> CommandStart
-pushLocal branch = do
+pushLocal syncbranch = go =<< inRepo (Git.Ref.exists syncbranch)
-	let syncBranch = Git.Ref.under "refs/heads/synced" branch
+	where
-	ex <- inRepo $ Git.Ref.exists syncBranch
+		go False = stop
-	if ex then do
+		go True = do
-		showStart "updating" $
+			unlessM (updatebranch) $
-			Git.Ref.describe syncBranch ++
+				error $ "failed to update " ++ show syncbranch
-			" to the state of " ++ Git.Ref.describe branch ++ "..."
+			stop
-		next $ next $
+		updatebranch = inRepo $ Git.Command.runBool "branch"
-			inRepo $ Git.Command.runBool "branch"
 			[ Param "-f"
-				, Param $ show $ Git.Ref.base syncBranch
+			, Param $ show $ Git.Ref.base syncbranch
 			]
-	else
-		return Nothing
 
-mergeFromIfExists :: Git.Ref -> CommandStart
+mergeFromIfExists :: Git.Ref -> CommandCleanup
-mergeFromIfExists fromBranch = do
+mergeFromIfExists branch = go =<< inRepo (Git.Ref.exists branch)
-	ex <- inRepo $ Git.Ref.exists fromBranch
+	where
-	if ex then do
+		go True = 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
+			inRepo $ Git.Command.runBool "merge"
+				[Param (show branch)]
+		go False = do
+			showNote $ Git.Ref.describe branch ++
+				" does not exist, not merging"
+			return False
 
-fetch :: Remote.Remote Annex -> CommandStart
+update :: Remote.Remote Annex -> Git.Ref -> CommandStart
-fetch remote = do
+update remote branch = do
-	showStart "fetching from" (Remote.name remote)
+	showStart "update" (Remote.name remote)
-	next $ next $ do
+	next $ do
-		showOutput
 		checkRemote remote
-		inRepo $ Git.Command.runBool "fetch" [Param (Remote.name remote)]
+		showOutput
+		fetched <- inRepo $ Git.Command.runBool "fetch" [Param (Remote.name remote)]
+		if fetched
+			then next $ mergeRemote remote branch
+			else stop
 
-mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
+mergeRemote :: Remote.Remote Annex -> Git.Ref -> CommandCleanup
 mergeRemote remote = mergeFromIfExists .
 	Git.Ref.under ("refs/remotes/" ++ Remote.name remote ++ "/synced")
 
-pushRemote :: Remote.Remote Annex -> Git.Ref -> CommandStart
+pushRemote :: Remote.Remote Annex -> Git.Ref -> Git.Ref -> CommandStart
-pushRemote remote branch = do
+pushRemote remote branch syncbranch = do
-	showStart "pushing to" (Remote.name remote)
+	showStart "push" (Remote.name remote)
-	let syncbranch = Git.Ref.under "refs/heads/synced" branch
 	let syncbranchRemote = Git.Ref.under
 		("refs/remotes/" ++ Remote.name remote) syncbranch
 	let refspec = show (Git.Ref.base branch) ++ ":" ++ show (Git.Ref.base syncbranch)
@@ -139,6 +140,6 @@ checkRemote remote = do
 		error $ "No url is configured for the remote: " ++ Remote.name remote
 
 mergeAnnex :: CommandStart
-mergeAnnex = next $ next $ do
+mergeAnnex = do
 	Annex.Branch.forceUpdate
-	return True
+	stop