aboutsummaryrefslogtreecommitdiff
path: root/Command/Sync.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2016-02-29 15:23:08 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2016-02-29 15:23:08 -0400
commit0fbaf6062e95885daf0da056c2a77d9e20154d41 (patch)
tree1d1d1b85bc5960e383a9705b9a25b65c8a99b48b /Command/Sync.hs
parent03e0498964647559f5eeece6750c8a2999860ae0 (diff)
make sync aware of adjusted branches
So, it will pull and push the original branch, not the adjusted one. And, for merging, it will use updateAdjustedBranch (not implemented yet). Note that remaining uses of Git.Branch.current need to be checked too; for things that should act on the original branch, and not the adjusted branch.
Diffstat (limited to 'Command/Sync.hs')
-rw-r--r--Command/Sync.hs90
1 files changed, 56 insertions, 34 deletions
diff --git a/Command/Sync.hs b/Command/Sync.hs
index 0c12fa090..b362d7c1e 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -8,6 +8,8 @@
module Command.Sync (
cmd,
+ CurrBranch,
+ getCurrBranch,
prepMerge,
mergeLocal,
mergeRemote,
@@ -43,6 +45,7 @@ import Annex.Drop
import Annex.UUID
import Logs.UUID
import Annex.AutoMerge
+import Annex.AdjustedBranch
import Annex.Ssh
import Annex.BloomFilter
import Utility.Bloom
@@ -95,20 +98,7 @@ seek :: SyncOptions -> CommandSeek
seek o = allowConcurrentOutput $ do
prepMerge
- -- There may not be a branch checked out until after the commit,
- -- or perhaps after it gets merged from the remote, or perhaps
- -- never.
- -- So only look it up once it's needed, and once there is a
- -- branch, cache it.
- mvar <- liftIO newEmptyMVar
- let getbranch = ifM (liftIO $ isEmptyMVar mvar)
- ( do
- branch <- inRepo Git.Branch.current
- when (isJust branch) $
- liftIO $ putMVar mvar branch
- return branch
- , liftIO $ readMVar mvar
- )
+ getbranch <- getCurrBranch
let withbranch a = a =<< getbranch
remotes <- syncRemotes (syncWith o)
@@ -140,6 +130,35 @@ seek o = allowConcurrentOutput $ do
-- Pushes to remotes can run concurrently.
mapM_ (commandAction . withbranch . pushRemote o) gitremotes
+type CurrBranch = (Maybe Git.Branch, Maybe Adjustment)
+
+{- There may not be a branch checked out until after the commit,
+ - or perhaps after it gets merged from the remote, or perhaps
+ - never.
+ -
+ - So only look it up once it's needed, and once there is a
+ - branch, cache it.
+ -
+ - When on an adjusted branch, gets the original branch, and the adjustment.
+ -}
+getCurrBranch :: Annex (Annex CurrBranch)
+getCurrBranch = do
+ mvar <- liftIO newEmptyMVar
+ return $ ifM (liftIO $ isEmptyMVar mvar)
+ ( do
+ currbranch <- inRepo Git.Branch.current
+ case currbranch of
+ Nothing -> return (Nothing, Nothing)
+ Just b -> do
+ let v = case adjustedToOriginal b of
+ Nothing -> (Just b, Nothing)
+ Just (adj, origbranch) ->
+ (Just origbranch, Just adj)
+ liftIO $ putMVar mvar v
+ return v
+ , liftIO $ readMVar mvar
+ )
+
{- Merging may delete the current directory, so go to the top
- of the repo. This also means that sync always acts on all files in the
- repository, not just on a subdirectory. -}
@@ -216,9 +235,9 @@ commitStaged commitmode commitmessage = do
void $ inRepo $ Git.Branch.commit commitmode False commitmessage branch parents
return True
-mergeLocal :: Maybe Git.Ref -> CommandStart
-mergeLocal Nothing = stop
-mergeLocal (Just branch) = go =<< needmerge
+mergeLocal :: CurrBranch -> CommandStart
+mergeLocal (Nothing, _) = stop
+mergeLocal (Just branch, madj) = go =<< needmerge
where
syncbranch = syncBranch branch
needmerge = ifM isBareRepo
@@ -231,16 +250,18 @@ mergeLocal (Just branch) = go =<< needmerge
go False = stop
go True = do
showStart "merge" $ Git.Ref.describe syncbranch
- next $ next $ autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit
+ next $ next $ case madj of
+ Nothing -> autoMergeFrom syncbranch (Just branch) Git.Branch.ManualCommit
+ Just adj -> updateAdjustedBranch adj branch syncbranch
-pushLocal :: Maybe Git.Ref -> CommandStart
+pushLocal :: CurrBranch -> CommandStart
pushLocal b = do
updateSyncBranch b
stop
-updateSyncBranch :: Maybe Git.Ref -> Annex ()
-updateSyncBranch Nothing = noop
-updateSyncBranch (Just branch) = do
+updateSyncBranch :: CurrBranch -> Annex ()
+updateSyncBranch (Nothing, _) = noop
+updateSyncBranch (Just branch, _) = do
-- Update the sync branch to match the new state of the branch
inRepo $ updateBranch $ syncBranch branch
-- In direct mode, we're operating on some special direct mode
@@ -249,7 +270,7 @@ updateSyncBranch (Just branch) = do
whenM isDirect $
inRepo $ updateBranch $ fromDirectBranch branch
-updateBranch :: Git.Ref -> Git.Repo -> IO ()
+updateBranch :: Git.Branch -> Git.Repo -> IO ()
updateBranch syncbranch g =
unlessM go $ error $ "failed to update " ++ Git.fromRef syncbranch
where
@@ -259,7 +280,7 @@ updateBranch syncbranch g =
, Param $ Git.fromRef $ Git.Ref.base syncbranch
] g
-pullRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
+pullRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
showStart "pull" (Remote.name remote)
next $ do
@@ -276,26 +297,27 @@ pullRemote o remote branch = stopUnless (pure $ pullOption o) $ do
- were committed (or pushed changes, if this is a bare remote),
- while the synced/master may have changes that some
- other remote synced to this remote. So, merge them both. -}
-mergeRemote :: Remote -> Maybe Git.Ref -> CommandCleanup
+mergeRemote :: Remote -> CurrBranch -> CommandCleanup
mergeRemote remote b = ifM isBareRepo
( return True
, case b of
- Nothing -> do
+ (Nothing, _) -> do
branch <- inRepo Git.Branch.currentUnsafe
- and <$> mapM (merge Nothing) (branchlist branch)
- Just thisbranch -> do
- inRepo $ updateBranch $ syncBranch thisbranch
- and <$> (mapM (merge (Just thisbranch)) =<< tomerge (branchlist b))
+ and <$> mapM (merge Nothing Nothing) (branchlist branch)
+ (Just currbranch, madj) -> do
+ inRepo $ updateBranch $ syncBranch currbranch
+ and <$> (mapM (merge (Just currbranch) madj) =<< tomerge (branchlist (Just currbranch)))
)
where
- merge thisbranch br = autoMergeFrom (remoteBranch remote br) thisbranch Git.Branch.ManualCommit
+ merge (Just origbranch) (Just adj) br = updateAdjustedBranch adj origbranch br
+ merge currbranch _ br = autoMergeFrom (remoteBranch remote br) currbranch Git.Branch.ManualCommit
tomerge = filterM (changed remote)
branchlist Nothing = []
branchlist (Just branch) = [branch, syncBranch branch]
-pushRemote :: SyncOptions -> Remote -> Maybe Git.Ref -> CommandStart
-pushRemote _o _remote Nothing = stop
-pushRemote o remote (Just branch) = stopUnless (pure (pushOption o) <&&> needpush) $ do
+pushRemote :: SyncOptions -> Remote -> CurrBranch -> CommandStart
+pushRemote _o _remote (Nothing, _) = stop
+pushRemote o remote (Just branch, _) = stopUnless (pure (pushOption o) <&&> needpush) $ do
showStart "push" (Remote.name remote)
next $ next $ do
showOutput