add more alerts

Nearly all long-running actions now display an alert.
This commit is contained in:
Joey Hess 2012-07-29 17:53:18 -04:00
parent ce7889ba86
commit b2dc8fdb06
3 changed files with 53 additions and 29 deletions

View file

@ -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.
-