converted 6 more threads
This commit is contained in:
parent
bad88e404a
commit
76768ad977
8 changed files with 350 additions and 370 deletions
|
@ -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.
|
||||
-
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue