avoid false alert about syncing with xmpp remote

This commit is contained in:
Joey Hess 2013-03-06 17:54:45 -04:00
parent 1340b9f493
commit aaec2cbf03
2 changed files with 16 additions and 15 deletions

View file

@ -62,7 +62,7 @@ reconnectRemotes notifypushes rs = void $ do
sync (Just branch) = do
diverged <- snd <$> manualPull (Just branch) gitremotes
now <- liftIO getCurrentTime
ok <- pushToRemotes now notifypushes gitremotes
ok <- pushToRemotes' now notifypushes gitremotes
return (ok, diverged)
{- No local branch exists yet, but we can try pulling. -}
sync Nothing = do
@ -97,8 +97,16 @@ reconnectRemotes notifypushes rs = void $ do
- reachable. If the fallback fails, the push is queued to be retried
- later.
-}
pushToRemotes :: UTCTime -> Bool -> [Remote] -> Assistant Bool
pushToRemotes now notifypushes remotes = do
pushToRemotes :: Bool -> [Remote] -> Assistant Bool
pushToRemotes notifypushes remotes = do
now <- liftIO $ getCurrentTime
let nonxmppremotes = snd $ partition isXMPPRemote remotes
let go = pushToRemotes' now notifypushes remotes
if null nonxmppremotes
then go
else alertWhile (pushAlert nonxmppremotes) go
pushToRemotes' :: UTCTime -> Bool -> [Remote] -> Assistant Bool
pushToRemotes' now notifypushes remotes = do
(g, branch, u) <- liftAnnex $ do
Annex.Branch.commit "update"
(,,)

View file

@ -17,8 +17,6 @@ import Assistant.Sync
import Utility.ThreadScheduler
import qualified Types.Remote as Remote
import Data.Time.Clock
{- This thread retries pushes that failed before. -}
pushRetryThread :: NamedThread
pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
@ -27,9 +25,8 @@ pushRetryThread = namedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
topush <- getFailedPushesBefore (fromIntegral halfhour)
unless (null topush) $ do
debug ["retrying", show (length topush), "failed pushes"]
void $ alertWhile (pushRetryAlert topush) $ do
now <- liftIO $ getCurrentTime
pushToRemotes now True topush
void $ alertWhile (pushRetryAlert topush) $
pushToRemotes True topush
where
halfhour = 1800
@ -41,13 +38,9 @@ pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do
commits <- getCommits
-- Now see if now's a good time to push.
if shouldPush commits
then do
remotes <- filter (not . Remote.readonly)
. syncGitRemotes <$> getDaemonStatus
unless (null remotes) $
void $ alertWhile (pushAlert remotes) $ do
now <- liftIO $ getCurrentTime
pushToRemotes now True remotes
then void $ pushToRemotes True
=<< filter (not . Remote.readonly) . syncGitRemotes
<$> getDaemonStatus
else do
debug ["delaying push of", show (length commits), "commits"]
refillCommits commits