summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/AdjustedBranch.hs2
-rw-r--r--Annex/TaggedPush.hs8
-rw-r--r--CHANGELOG1
-rw-r--r--Command/Sync.hs89
-rw-r--r--Git/Ref.hs22
-rw-r--r--doc/git-annex-sync.mdwn13
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)