diff options
| -rw-r--r-- | Annex/AdjustedBranch.hs | 2 | ||||
| -rw-r--r-- | Annex/TaggedPush.hs | 8 | ||||
| -rw-r--r-- | CHANGELOG | 1 | ||||
| -rw-r--r-- | Command/Sync.hs | 89 | ||||
| -rw-r--r-- | Git/Ref.hs | 22 | ||||
| -rw-r--r-- | doc/git-annex-sync.mdwn | 13 |
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" @@ -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) |