converted 6 more threads

This commit is contained in:
Joey Hess 2012-10-29 11:40:22 -04:00
parent bad88e404a
commit 76768ad977
8 changed files with 350 additions and 370 deletions

View file

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