sync: Added --cleanup, which removes local and remote synced/ branches.

Also deletes any tagged pushes that the assistant might have done,
since those would also prevent resetting a branch back.

This commit was sponsored by andrea rota.

6 files changed, 107 insertions, 28 deletions

diff --git a/Annex/AdjustedBranch.hs b/Annex/AdjustedBranch.hs
index 52f73e638..9eedf06f5 100644
--- a/Annex/AdjustedBranch.hs
+++ b/Annex/AdjustedBranch.hs
@@ -167,7 +167,7 @@ adjustedToOriginal b
 	| adjustedBranchPrefix `isPrefixOf` bs = do
 		let (base, as) = separate (== '(') (drop prefixlen bs)
 		adj <- deserialize (takeWhile (/= ')') as)
-		Just (adj, Git.Ref.underBase "refs/heads" (Ref base))
+		Just (adj, Git.Ref.branchRef (Ref base))
 	| otherwise = Nothing
   where
 	bs = fromRef b
diff --git a/Annex/TaggedPush.hs b/Annex/TaggedPush.hs
index 3b06170b3..13c53a3ca 100644
--- a/Annex/TaggedPush.hs
+++ b/Annex/TaggedPush.hs
@@ -30,7 +30,7 @@ import Utility.Base64
  - Both UUIDs and Base64 encoded data are always legal to be used in git
  - refs, per git-check-ref-format.
  -}
-toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Branch
+toTaggedBranch :: UUID -> Maybe String -> Git.Branch -> Git.Ref
 toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes
 	[ Just "refs/synced"
 	, Just $ fromUUID u
@@ -38,7 +38,7 @@ toTaggedBranch u info b = Git.Ref $ intercalate "/" $ catMaybes
 	, Just $ Git.fromRef $ Git.Ref.base b
 	]
 
-fromTaggedBranch :: Git.Branch -> Maybe (UUID, Maybe String)
+fromTaggedBranch :: Git.Ref -> Maybe (UUID, Maybe String)
 fromTaggedBranch b = case splitc '/' $ Git.fromRef b of
 	("refs":"synced":u:info:_base) ->
 		Just (toUUID u, fromB64Maybe info)
@@ -46,6 +46,10 @@ fromTaggedBranch b = case splitc '/' $ Git.fromRef b of
 		Just (toUUID u, Nothing)
 	_ -> Nothing
 
+listTaggedBranches :: Annex [(Git.Sha, Git.Ref)]
+listTaggedBranches = filter (isJust . fromTaggedBranch . snd)
+	<$> inRepo Git.Ref.list
+
 taggedPush :: UUID -> Maybe String -> Git.Ref -> Remote -> Git.Repo -> IO Bool
 taggedPush u info branch remote = Git.Command.runBool
 	[ Param "push"
diff --git a/CHANGELOG b/CHANGELOG
index 3027d87c0..9b3c090ae 100644
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -6,6 +6,7 @@ git-annex (6.20170926) UNRELEASED; urgency=medium
   * Warn when metadata is inherited from a previous version of a file,
     to avoid the user being surprised in cases where that behavior is not
     desired or expected.
+  * sync: Added --cleanup, which removes local and remote synced/ branches.
 
  -- Joey Hess <id@joeyh.name>  Thu, 28 Sep 2017 12:01:39 -0400
 
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 44948ea74..4c3b90969 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -59,6 +59,7 @@ import Annex.BloomFilter
 import Annex.UpdateInstead
 import Annex.Export
 import Annex.LockFile
+import Annex.TaggedPush
 import qualified Database.Export as Export
 import Utility.Bloom
 import Utility.OptParse
@@ -82,6 +83,7 @@ data SyncOptions  = SyncOptions
 	, contentOption :: Bool
 	, noContentOption :: Bool
 	, contentOfOption :: [FilePath]
+	, cleanupOption :: Bool
 	, keyOptions :: Maybe KeyOptions
 	, resolveMergeOverride :: ResolveMergeOverride
 	}
@@ -129,6 +131,10 @@ optParser desc = SyncOptions
 		<> help "transfer file contents of files in a given location"
 		<> metavar paramPath
 		))
+	<*> switch
+		( long "cleanup"
+		<> help "remove synced/ branches from previous sync"
+		)
 	<*> optional parseAllOption
 	<*> (ResolveMergeOverride <$> invertableSwitch "resolvemerge" True
 		( help "do not automatically resolve merge conflicts"
@@ -147,6 +153,7 @@ instance DeferredParseClass SyncOptions where
 		<*> pure (contentOption v)
 		<*> pure (noContentOption v)
 		<*> liftIO (mapM absPath (contentOfOption v))
+		<*> pure (cleanupOption v)
 		<*> pure (keyOptions v)
 		<*> pure (resolveMergeOverride v)
 
@@ -163,32 +170,39 @@ seek o = allowConcurrentOutput $ do
 		. filter (\r -> Remote.uuid r /= NoUUID)
 		<$> filterM (not <$$> liftIO . getDynamicConfig . remoteAnnexIgnore . Remote.gitconfig) remotes
 
-	-- Syncing involves many actions, any of which can independently
-	-- fail, without preventing the others from running.
-	-- These actions cannot be run concurrently.
-	mapM_ includeCommandAction $ concat
-		[ [ commit o ]
-		, [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ]
-		, map (withbranch . pullRemote o mergeConfig) gitremotes
-		,  [ mergeAnnex ]
-		]
-	whenM shouldsynccontent $ do
-		syncedcontent <- seekSyncContent o dataremotes
-		exportedcontent <- seekExportContent exportremotes
-		-- Transferring content can take a while,
-		-- and other changes can be pushed to the git-annex
-		-- branch on the remotes in the meantime, so pull
-		-- and merge again to avoid our push overwriting
-		-- those changes.
-		when (syncedcontent || exportedcontent) $ do
+	if cleanupOption o
+		then do
+			commandAction (withbranch cleanupLocal)
+			mapM_ (commandAction . withbranch . cleanupRemote) gitremotes
+		else do
+			-- Syncing involves many actions, any of which
+			-- can independently fail, without preventing
+			-- the others from running. 
+			-- These actions cannot be run concurrently.
 			mapM_ includeCommandAction $ concat
-				[ map (withbranch . pullRemote o mergeConfig) gitremotes
-				, [ commitAnnex, mergeAnnex ]
+				[ [ commit o ]
+				, [ withbranch (mergeLocal mergeConfig (resolveMergeOverride o)) ]
+				, map (withbranch . pullRemote o mergeConfig) gitremotes
+				,  [ mergeAnnex ]
 				]
+			
+			whenM shouldsynccontent $ do
+				syncedcontent <- seekSyncContent o dataremotes
+				exportedcontent <- seekExportContent exportremotes
+				-- Transferring content can take a while,
+				-- and other changes can be pushed to the
+				-- git-annex branch on the remotes in the
+				-- meantime, so pull and merge again to
+				-- avoid our push overwriting those changes.
+				when (syncedcontent || exportedcontent) $ do
+					mapM_ includeCommandAction $ concat
+						[ map (withbranch . pullRemote o mergeConfig) gitremotes
+						, [ commitAnnex, mergeAnnex ]
+						]
 	
-	void $ includeCommandAction $ withbranch pushLocal
-	-- Pushes to remotes can run concurrently.
-	mapM_ (commandAction . withbranch . pushRemote o) gitremotes
+			void $ includeCommandAction $ withbranch pushLocal
+			-- Pushes to remotes can run concurrently.
+			mapM_ (commandAction . withbranch . pushRemote o) gitremotes
   where
 	shouldsynccontent = pure (contentOption o)
 		<||> pure (not (null (contentOfOption o)))
@@ -682,3 +696,32 @@ seekExportContent rs = or <$> forM rs go
 			Remote.name r ++ 
 			". Use git-annex export to resolve this conflict."
 		return False
+
+cleanupLocal :: CurrBranch -> CommandStart
+cleanupLocal (Nothing, _) = stop
+cleanupLocal (Just currb, _) = do
+	showStart "cleanup" "local"
+	next $ next $ do
+		delbranch $ syncBranch currb
+		delbranch $ syncBranch $ Git.Ref.base $ Annex.Branch.name
+		mapM_ (\(s,r) -> inRepo $ Git.Ref.delete s r)
+			=<< listTaggedBranches
+		return True
+  where
+	delbranch b = whenM (inRepo $ Git.Ref.exists $ Git.Ref.branchRef b) $
+		inRepo $ Git.Branch.delete b
+
+cleanupRemote :: Remote -> CurrBranch -> CommandStart
+cleanupRemote _ (Nothing, _) = stop
+cleanupRemote remote (Just b, _) = do
+	showStart "cleanup" (Remote.name remote)
+	next $ next $
+		inRepo $ Git.Command.runBool
+			[ Param "push"
+			, Param "--quiet"
+			, Param "--delete"
+			, Param $ Remote.name remote
+			, Param $ Git.fromRef $ syncBranch b
+			, Param $ Git.fromRef $ syncBranch $
+				Git.Ref.base $ Annex.Branch.name
+			]
diff --git a/Git/Ref.hs b/Git/Ref.hs
index 2d8013738..06fc5dcd7 100644
--- a/Git/Ref.hs
+++ b/Git/Ref.hs
@@ -45,6 +45,10 @@ base = Ref . remove "refs/heads/" . remove "refs/remotes/" . fromRef
 underBase :: String -> Ref -> Ref
 underBase dir r = Ref $ dir ++ "/" ++ fromRef (base r)
 
+{- Convert a branch such as "master" into a fully qualified ref. -}
+branchRef :: Branch -> Ref
+branchRef = underBase "refs/heads"
+
 {- A Ref that can be used to refer to a file in the repository, as staged
  - in the index.
  -
@@ -101,7 +105,7 @@ matching refs repo =  matching' (map fromRef refs) repo
 matchingWithHEAD :: [Ref] -> Repo -> IO [(Sha, Branch)]
 matchingWithHEAD refs repo = matching' ("--head" : map fromRef refs) repo
 
-{- List of (shas, branches) matching a given ref or refs. -}
+{- List of (shas, branches) matching a given ref spec. -}
 matching' :: [String] -> Repo -> IO [(Sha, Branch)]
 matching' ps repo = map gen . lines <$> 
 	pipeReadStrict (Param "show-ref" : map Param ps) repo
@@ -109,13 +113,27 @@ matching' ps repo = map gen . lines <$>
 	gen l = let (r, b) = separate (== ' ') l
 		in (Ref r, Ref b)
 
-{- List of (shas, branches) matching a given ref spec.
+{- List of (shas, branches) matching a given ref.
  - Duplicate shas are filtered out. -}
 matchingUniq :: [Ref] -> Repo -> IO [(Sha, Branch)]
 matchingUniq refs repo = nubBy uniqref <$> matching refs repo
   where
 	uniqref (a, _) (b, _) = a == b
 
+{- List of all refs. -}
+list :: Repo -> IO [(Sha, Ref)]
+list = matching' []
+
+{- Deletes a ref. This can delete refs that are not branches, 
+ - which git branch --delete refuses to delete. -}
+delete :: Sha -> Ref -> Repo -> IO ()
+delete oldvalue ref = run
+	[ Param "update-ref"
+	, Param "-d"
+	, Param $ fromRef ref
+	, Param $ fromRef oldvalue
+	]
+
 {- Gets the sha of the tree a ref uses. -}
 tree :: Ref -> Repo -> IO (Maybe Sha)
 tree ref = extractSha <$$> pipeReadStrict
diff --git a/doc/git-annex-sync.mdwn b/doc/git-annex-sync.mdwn
index 7b03a2ed1..f4d644fd3 100644
--- a/doc/git-annex-sync.mdwn
+++ b/doc/git-annex-sync.mdwn
@@ -125,6 +125,19 @@ by running "git annex sync" on the remote.
   resolution. It can also be disabled by setting annex.resolvemerge
   to false.
 
+* `--cleanup`
+
+  Removes the local and remote `synced/` branches, which were created
+  and pushed by `git-annex sync`.
+
+  This can come in handy when you've synced a change to remotes and now
+  want to reset your master branch back before that change. So you
+  run `git reset` and force-push the master branch to remotes, only
+  to find that the next `git annex merge` or `git annex sync` brings the
+  changes back. Why? Because the `synced/master` branch is hanging
+  around and still has the change in it. Cleaning up the `synced/` branches
+  prevents that problem.
+
 # SEE ALSO
 
 [[git-annex]](1)