diff options
author | Joey Hess <joey@kitenet.net> | 2012-07-29 17:53:18 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-07-29 17:53:18 -0400 |
commit | b2dc8fdb06068276869df682b439348aa96e57f5 (patch) | |
tree | 0514da7693e10eb08d7f4a5d5d96665f7a66d81a /Assistant/Threads/Pusher.hs | |
parent | ce7889ba86fc15e2892db8190114e291128e9c62 (diff) |
add more alerts
Nearly all long-running actions now display an alert.
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r-- | Assistant/Threads/Pusher.hs | 23 |
1 files changed, 16 insertions, 7 deletions
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index 3762c4836..27e95a734 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -10,12 +10,14 @@ module Assistant.Threads.Pusher where import Assistant.Common import Assistant.Commits import Assistant.Pushes -import Assistant.DaemonStatus +import Assistant.Alert import Assistant.ThreadedMonad import Assistant.Threads.Merger +import Assistant.DaemonStatus import qualified Command.Sync import Utility.ThreadScheduler import Utility.Parallel +import qualified Remote import Data.Time.Clock import qualified Data.Map as M @@ -24,8 +26,8 @@ thisThread :: ThreadName thisThread = "Pusher" {- This thread retries pushes that failed before. -} -pushRetryThread :: ThreadState -> FailedPushMap -> IO () -pushRetryThread st pushmap = runEvery (Seconds halfhour) $ do +pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> IO () +pushRetryThread st dstatus pushmap = runEvery (Seconds halfhour) $ do -- We already waited half an hour, now wait until there are failed -- pushes to retry. topush <- getFailedPushesBefore pushmap (fromIntegral halfhour) @@ -36,13 +38,16 @@ pushRetryThread st pushmap = runEvery (Seconds halfhour) $ do , "failed pushes" ] now <- getCurrentTime - pushToRemotes thisThread now st (Just pushmap) topush + alertWhile dstatus (alert topush) $ + pushToRemotes thisThread now st (Just pushmap) topush where halfhour = 1800 + alert rs = activityAlert (Just "Retrying sync") $ + "with " ++ unwords (map Remote.name rs) ++ ", which failed earlier." {- This thread pushes git commits out to remotes soon after they are made. -} pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> IO () -pushThread st daemonstatus commitchan pushmap = do +pushThread st dstatus commitchan pushmap = do runEvery (Seconds 2) $ do -- We already waited two seconds as a simple rate limiter. -- Next, wait until at least one commit has been made @@ -51,8 +56,9 @@ pushThread st daemonstatus commitchan pushmap = do now <- getCurrentTime if shouldPush now commits then do - remotes <- knownRemotes <$> getDaemonStatus daemonstatus - pushToRemotes thisThread now st (Just pushmap) remotes + remotes <- knownRemotes <$> getDaemonStatus dstatus + alertWhile dstatus (syncalert remotes) $ + pushToRemotes thisThread now st (Just pushmap) remotes else do debug thisThread [ "delaying push of" @@ -60,6 +66,9 @@ pushThread st daemonstatus commitchan pushmap = do , "commits" ] refillCommits commitchan commits + where + syncalert rs = activityAlert Nothing $ + "Syncing with " ++ unwords (map Remote.name rs) {- Decide if now is a good time to push to remotes. - |