summaryrefslogtreecommitdiff
path: root/Assistant/Threads/Pusher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-29 11:40:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-29 11:40:22 -0400
commitf901112e1ce30f43dc7294e0bd0616bb02556500 (patch)
tree92ab6d6f220ea21e0cc7feeff6caca52d4d2b677 /Assistant/Threads/Pusher.hs
parent710dfa7e3ec897d6f02930540b10bb303e3a9c91 (diff)
converted 6 more threads
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r--Assistant/Threads/Pusher.hs58
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.
-