summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Pusher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-07-29 17:53:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-07-29 17:53:18 -0400
commitb2dc8fdb06068276869df682b439348aa96e57f5 (patch)
tree0514da7693e10eb08d7f4a5d5d96665f7a66d81a /Assistant/Threads/Pusher.hs
parentce7889ba86fc15e2892db8190114e291128e9c62 (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.hs23
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.
-