diff options
author | 2012-10-29 11:40:22 -0400 | |
---|---|---|
committer | 2012-10-29 11:40:22 -0400 | |
commit | f901112e1ce30f43dc7294e0bd0616bb02556500 (patch) | |
tree | 92ab6d6f220ea21e0cc7feeff6caca52d4d2b677 /Assistant/Threads/Pusher.hs | |
parent | 710dfa7e3ec897d6f02930540b10bb303e3a9c91 (diff) |
converted 6 more threads
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r-- | Assistant/Threads/Pusher.hs | 58 |
1 files changed, 27 insertions, 31 deletions
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs index a15c0e152..811314651 100644 --- a/Assistant/Threads/Pusher.hs +++ b/Assistant/Threads/Pusher.hs @@ -11,7 +11,6 @@ import Assistant.Common import Assistant.Commits import Assistant.Pushes import Assistant.Alert -import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.Sync import Utility.ThreadScheduler @@ -24,52 +23,49 @@ thisThread :: ThreadName thisThread = "Pusher" {- This thread retries pushes that failed before. -} -pushRetryThread :: ThreadState -> DaemonStatusHandle -> FailedPushMap -> PushNotifier -> NamedThread -pushRetryThread st dstatus pushmap pushnotifier = thread $ liftIO $ runEvery (Seconds halfhour) $ do +pushRetryThread :: NamedThread +pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do -- We already waited half an hour, now wait until there are failed -- pushes to retry. - topush <- getFailedPushesBefore pushmap (fromIntegral halfhour) + pushmap <- getAssistant failedPushMap + topush <- liftIO $ getFailedPushesBefore pushmap (fromIntegral halfhour) unless (null topush) $ do - brokendebug thisThread - [ "retrying" - , show (length topush) - , "failed pushes" - ] - now <- getCurrentTime - void $ alertWhile dstatus (pushRetryAlert topush) $ + debug ["retrying", show (length topush), "failed pushes"] + now <- liftIO $ getCurrentTime + st <- getAssistant threadState + pushnotifier <- getAssistant pushNotifier + dstatus <- getAssistant daemonStatusHandle + void $ liftIO $ alertWhile dstatus (pushRetryAlert topush) $ pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) topush where halfhour = 1800 - thread = NamedThread thisThread {- This thread pushes git commits out to remotes soon after they are made. -} -pushThread :: ThreadState -> DaemonStatusHandle -> CommitChan -> FailedPushMap -> PushNotifier -> NamedThread -pushThread st dstatus commitchan pushmap pushnotifier = thread $ liftIO $ runEvery (Seconds 2) $ do +pushThread :: NamedThread +pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do -- We already waited two seconds as a simple rate limiter. -- Next, wait until at least one commit has been made - commits <- getCommits commitchan + commits <- getCommits <<~ commitChan -- Now see if now's a good time to push. if shouldPush commits then do - remotes <- filter pushable . syncRemotes - <$> getDaemonStatus dstatus + remotes <- filter pushable . syncRemotes <$> daemonStatus unless (null remotes) $ do - now <- getCurrentTime - void $ alertWhile dstatus (pushAlert remotes) $ + now <- liftIO $ getCurrentTime + st <- getAssistant threadState + pushmap <- getAssistant failedPushMap + pushnotifier <- getAssistant pushNotifier + dstatus <- getAssistant daemonStatusHandle + void $ liftIO $ alertWhile dstatus (pushAlert remotes) $ pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) remotes else do - brokendebug thisThread - [ "delaying push of" - , show (length commits) - , "commits" - ] - refillCommits commitchan commits - where - thread = NamedThread thisThread - pushable r - | Remote.specialRemote r = False - | Remote.readonly r = False - | otherwise = True + debug ["delaying push of", show (length commits), "commits"] + flip refillCommits commits <<~ commitChan + where + pushable r + | Remote.specialRemote r = False + | Remote.readonly r = False + | otherwise = True {- Decide if now is a good time to push to remotes. - |