mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

more lifting

Browse source
This commit is contained in:
Joey Hess 2012-10-29 16:28:45 -04:00
parent 805ef65679
commit 94ae5d14e5
2 changed files with 14 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Assistant/Sync.hs
View file

@ -10,7 +10,6 @@ module Assistant.Sync where
import Assistant.Common import Assistant.Common
import Assistant.Pushes import Assistant.Pushes
import Assistant.Alert import Assistant.Alert
import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.ScanRemotes import Assistant.ScanRemotes
import qualified Command.Sync import qualified Command.Sync
@ -50,15 +49,13 @@ reconnectRemotes notifypushes rs = void $ do
(gitremotes, _specialremotes) = (gitremotes, _specialremotes) =
partition (Git.repoIsUrl . Remote.repo) rs partition (Git.repoIsUrl . Remote.repo) rs
sync (Just branch) = do sync (Just branch) = do
st <- getAssistant threadState diverged <- snd <$> manualPull (Just branch) gitremotes
diverged <- liftIO $ snd <$> manualPull st (Just branch) gitremotes
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
ok <- pushToRemotes now notifypushes gitremotes ok <- pushToRemotes now notifypushes gitremotes
return (ok, diverged) return (ok, diverged)
{- No local branch exists yet, but we can try pulling. -} {- No local branch exists yet, but we can try pulling. -}
sync Nothing = do sync Nothing = do
st <- getAssistant threadState diverged <- snd <$> manualPull Nothing gitremotes
diverged <- liftIO $ snd <$> manualPull st Nothing gitremotes
return (True, diverged) return (True, diverged)
{- Updates the local sync branch, then pushes it to all remotes, in {- Updates the local sync branch, then pushes it to all remotes, in
@ -119,8 +116,7 @@ pushToRemotes now notifypushes remotes = do
retry branch g u rs = do retry branch g u rs = do
debug ["trying manual pull to resolve failed pushes"] debug ["trying manual pull to resolve failed pushes"]
st <- getAssistant threadState void $ manualPull (Just branch) rs
void $ liftIO $ manualPull st (Just branch) rs
go False (Just branch) g u rs go False (Just branch) g u rs
fallback branch g u rs = do fallback branch g u rs = do
@ -149,14 +145,14 @@ pushToRemotes now notifypushes remotes = do
where s = show $ Git.Ref.base b where s = show $ Git.Ref.base b
{- Manually pull from remotes and merge their branches. -} {- Manually pull from remotes and merge their branches. -}
manualPull :: ThreadState -> Maybe Git.Ref -> [Remote] -> IO ([Bool], Bool) manualPull :: Maybe Git.Ref -> [Remote] -> Assistant ([Bool], Bool)
manualPull st currentbranch remotes = do manualPull currentbranch remotes = do
g <- runThreadState st gitRepo g <- liftAnnex gitRepo
results <- forM remotes $ \r -> results <- liftIO $ forM remotes $ \r ->
Git.Command.runBool "fetch" [Param $ Remote.name r] g Git.Command.runBool "fetch" [Param $ Remote.name r] g
haddiverged <- runThreadState st Annex.Branch.forceUpdate haddiverged <- liftAnnex Annex.Branch.forceUpdate
forM_ remotes $ \r -> forM_ remotes $ \r ->
runThreadState st $ Command.Sync.mergeRemote r currentbranch liftAnnex $ Command.Sync.mergeRemote r currentbranch
return (results, haddiverged) return (results, haddiverged)
{- Start syncing a newly added remote, using a background thread. -} {- Start syncing a newly added remote, using a background thread. -}

11
Assistant/Threads/PushNotifier.hs
View file

@ -93,13 +93,12 @@ pull [] = noop
pull us = do pull us = do
rs <- filter matching . syncRemotes <$> daemonStatus rs <- filter matching . syncRemotes <$> daemonStatus
debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs debug $ "push notification for" : map (fromUUID . Remote.uuid ) rs
st <- getAssistant threadState pullone rs =<< liftAnnex (inRepo Git.Branch.current)
liftIO . pullone st rs =<< liftAnnex (inRepo Git.Branch.current)
where where
matching r = Remote.uuid r `S.member` s matching r = Remote.uuid r `S.member` s
s = S.fromList us s = S.fromList us
pullone _ [] _ = noop pullone [] _ = noop
pullone st (r:rs) branch = pullone (r:rs) branch =
unlessM (all id . fst <$> manualPull st branch [r]) $ unlessM (all id . fst <$> manualPull branch [r]) $
pullone st rs branch pullone rs branch