Merge train: infer candidate from state

src/Logic.hs

@@ -353,12 +353,10 @@ handlePullRequestClosedByUser :: PullRequestId -> ProjectState -> Action Project
 handlePullRequestClosedByUser = handlePullRequestClosed User
 
 handlePullRequestClosed :: PRCloseCause -> PullRequestId -> ProjectState -> Action ProjectState
-handlePullRequestClosed closingReason pr state = Pr.deletePullRequest pr <$>
-    case Pr.integrationCandidate state of
-      Just candidatePr | candidatePr == pr -> do
-        leaveComment pr $ prClosingMessage closingReason
-        pure state { Pr.integrationCandidate = Nothing }
-      _notCandidatePr -> pure state
+handlePullRequestClosed closingReason pr state = do
+  when (pr `elem` Pr.integratedPullRequests state) $
+    leaveComment pr $ prClosingMessage closingReason
+  pure $ Pr.deletePullRequest pr state
 
 handlePullRequestEdited :: PullRequestId -> Text -> BaseBranch -> ProjectState -> Action ProjectState
 handlePullRequestEdited prId newTitle newBaseBranch state =
@@ -530,18 +528,15 @@ handleMergeRequested projectConfig prId author state pr approvalType = do
 
 handleBuildStatusChanged :: Sha -> BuildStatus -> ProjectState -> ProjectState
 handleBuildStatusChanged buildSha newStatus state =
+  Pr.updatePullRequests setBuildStatus state
+  where
   -- If there is an integration candidate, and its integration sha matches that
   -- of the build, then update the build status for that pull request. Otherwise
   -- do nothing.
-  let
-    setBuildStatus pullRequest = case Pr.integrationStatus pullRequest of
-      Integrated candidateSha _oldStatus | candidateSha == buildSha ->
-        pullRequest { Pr.integrationStatus = Integrated buildSha newStatus }
-      _ -> pullRequest
-  in
-    case Pr.integrationCandidate state of
-      Just candidateId -> Pr.updatePullRequest candidateId setBuildStatus state
-      Nothing          -> state
+  setBuildStatus pullRequest = case Pr.integrationStatus pullRequest of
+    Integrated candidateSha _oldStatus | candidateSha == buildSha ->
+      pullRequest { Pr.integrationStatus = Integrated buildSha newStatus }
+    _ -> pullRequest
 
 -- Query the GitHub API to resolve inconsistencies between our state and GitHub.
 synchronizeState :: ProjectState -> Action ProjectState
@@ -585,38 +580,31 @@ synchronizeState stateInitial =
 proceed :: ProjectState -> Action ProjectState
 proceed state = do
   state' <- provideFeedback state
-  case Pr.getIntegrationCandidate state' of
-    Just candidate -> proceedCandidate candidate state'
-    -- No current integration candidate, find the next one.
-    Nothing -> case Pr.candidatePullRequests state' of
-      -- No pull requests eligible, do nothing.
-      []     -> return state'
-      -- Found a new candidate, try to integrate it.
-      pr : _ -> tryIntegratePullRequest pr state'
+  case (Pr.getIntegrationCandidates state', Pr.candidatePullRequests state') of
+                           -- Proceed with an already integrated candidate
+    (candidate:_, _)    -> proceedCandidate candidate state'
+                           -- Found a new candidate, try to integrate it.
+    (_,           pr:_) -> tryIntegratePullRequest pr state'
+                           -- No pull requests eligible, do nothing.
+    (_,           _)    -> return state'
 
 -- TODO: Get rid of the tuple; just pass the ID and do the lookup with fromJust.
 proceedCandidate :: (PullRequestId, PullRequest) -> ProjectState -> Action ProjectState
 proceedCandidate (pullRequestId, pullRequest) state =
   case Pr.integrationStatus pullRequest of
-    NotIntegrated ->
-      tryIntegratePullRequest pullRequestId state
-
-    IncorrectBaseBranch ->
-      -- It shouldn't come to this point; a PR with an incorrect base branch is
-      -- never considered as a candidate.
-      pure $ Pr.setIntegrationCandidate Nothing state
-
-    Conflicted _branch _ ->
-      -- If it conflicted, it should no longer be the integration candidate.
-      pure $ Pr.setIntegrationCandidate Nothing state
+    NotIntegrated -> pure state -- dead code / unreachable
 
     Integrated sha buildStatus -> case buildStatus of
       BuildPending   -> pure state
       BuildSucceeded -> pushCandidate (pullRequestId, pullRequest) sha state
-      BuildFailed _  -> do
-        -- If the build failed, this is no longer a candidate.
-        pure $ Pr.setIntegrationCandidate Nothing $
-          Pr.setNeedsFeedback pullRequestId True state
+                        -- If the build failed, give feedback on the PR
+      BuildFailed _  -> pure $ Pr.setNeedsFeedback pullRequestId True state
+
+    Promoted -> pure state -- dead code / unreachable
+
+    Conflicted _branch _ -> pure state -- dead code / unreachable
+
+    IncorrectBaseBranch -> pure state -- dead code / unreachable
 
 -- Given a pull request id, returns the name of the GitHub ref for that pull
 -- request, so it can be fetched.
@@ -652,11 +640,10 @@ tryIntegratePullRequest pr state =
           Pr.setNeedsFeedback pr True state
 
       Right (Sha sha) -> do
-        -- If it succeeded, update the integration candidate, and set the build
-        -- to pending, as pushing should have triggered a build.
+        -- If it succeeded, set the build to pending,
+        -- as pushing should have triggered a build.
         pure
           $ Pr.setIntegrationStatus pr (Integrated (Sha sha) BuildPending)
-          $ Pr.setIntegrationCandidate (Just pr)
           $ Pr.setNeedsFeedback pr True
           $ state
 
@@ -705,7 +692,7 @@ pushCandidate (pullRequestId, pullRequest) newHead state =
       -- GitHub will mark the pull request as closed, and when we receive that
       -- event, we delete the pull request from the state. Until then, reset
       -- the integration candidate, so we proceed with the next pull request.
-      PushOk -> pure $ Pr.setIntegrationCandidate Nothing state
+      PushOk -> pure $ Pr.setIntegrationStatus pullRequestId Promoted state
       -- If something was pushed to the target branch while the candidate was
       -- being tested, try to integrate again and hope that next time the push
       -- succeeds.

src/Project.hs

@@ -21,13 +21,14 @@ module Project
   PullRequestStatus (..),
   Owner,
   approvedPullRequests,
+  integratedPullRequests,
   candidatePullRequests,
   classifyPullRequest,
   classifyPullRequests,
   deletePullRequest,
   emptyProjectState,
   existsPullRequest,
-  getIntegrationCandidate,
+  getIntegrationCandidates,
   getQueuePosition,
   insertPullRequest,
   loadProjectState,
@@ -39,10 +40,10 @@ module Project
   displayApproval,
   setApproval,
   newApprovalOrder,
-  setIntegrationCandidate,
   setIntegrationStatus,
   setNeedsFeedback,
   updatePullRequest,
+  updatePullRequests,
   getOwners,
   wasIntegrationAttemptFor,
   MergeWindow(..))
@@ -75,13 +76,20 @@ data BuildStatus
   | BuildFailed (Maybe Text)
   deriving (Eq, Show, Generic)
 
--- When attempting to integrated changes, there can be three states: no attempt
--- has been made to integrate; integration (e.g. merge or rebase) was successful
--- and the new commit has the given sha; and an attempt to integrate was made,
--- but it wasn't successful.
+-- When attempting to integrated changes, there can be five states:
+--
+-- * no attempt has been made to integrate;
+--
+-- * integration (e.g. merge or rebase) was successful
+--   and the new commit has the given sha;
+--
+-- * the PR has been promoted to be the new master;
+--
+-- * and an attempt to integrate was made, but it wasn't successful.
 data IntegrationStatus
   = NotIntegrated
   | Integrated Sha BuildStatus
+  | Promoted
   | Conflicted BaseBranch GitIntegrationFailure
   | IncorrectBaseBranch
   deriving (Eq, Show, Generic)
@@ -133,7 +141,6 @@ data PullRequest = PullRequest
 
 data ProjectState = ProjectState
   { pullRequests              :: IntMap PullRequest
-  , integrationCandidate      :: Maybe PullRequestId
   , pullRequestApprovalIndex  :: Int
   }
   deriving (Eq, Show, Generic)
@@ -187,7 +194,6 @@ saveProjectState fname state = do
 emptyProjectState :: ProjectState
 emptyProjectState = ProjectState {
   pullRequests         = IntMap.empty,
-  integrationCandidate = Nothing,
   pullRequestApprovalIndex = 0
 }
 
@@ -236,6 +242,11 @@ updatePullRequest (PullRequestId n) f state = state {
   pullRequests = IntMap.adjust f n $ pullRequests state
 }
 
+updatePullRequests :: (PullRequest -> PullRequest) -> ProjectState -> ProjectState
+updatePullRequests f state = state {
+  pullRequests = IntMap.map f $ pullRequests state
+}
+
 -- Marks the pull request as approved by somebody or nobody.
 setApproval :: PullRequestId -> Maybe Approval -> ProjectState -> ProjectState
 setApproval pr newApproval = updatePullRequest pr changeApproval
@@ -260,16 +271,13 @@ setIntegrationStatus pr newStatus = updatePullRequest pr changeIntegrationStatus
         }
       _notIntegrated -> pullRequest { integrationStatus = newStatus }
 
-getIntegrationCandidate :: ProjectState -> Maybe (PullRequestId, PullRequest)
-getIntegrationCandidate state = do
-  pullRequestId <- integrationCandidate state
-  candidate     <- lookupPullRequest pullRequestId state
-  return (pullRequestId, candidate)
-
-setIntegrationCandidate :: Maybe PullRequestId -> ProjectState -> ProjectState
-setIntegrationCandidate pr state = state {
-  integrationCandidate = pr
-}
+-- Same as 'integratedPullRequests' but paired with the underlying objects.
+getIntegrationCandidates :: ProjectState -> [(PullRequestId, PullRequest)]
+getIntegrationCandidates state =
+  [ (pullRequestId, candidate)
+  | pullRequestId <- integratedPullRequests state
+  , Just candidate <- [lookupPullRequest pullRequestId state]
+  ]
 
 setNeedsFeedback :: PullRequestId -> Bool -> ProjectState -> ProjectState
 setNeedsFeedback pr value = updatePullRequest pr (\pullRequest -> pullRequest { needsFeedback = value })
@@ -287,6 +295,7 @@ classifyPullRequest pr = case approval pr of
       BuildPending    -> PrStatusBuildPending
       BuildSucceeded  -> PrStatusIntegrated
       BuildFailed url -> PrStatusFailedBuild url
+    Promoted -> PrStatusIntegrated -- TODO: state-of-its-own?
 
 -- Classify every pull request into one status. Orders pull requests by id in
 -- ascending order.
@@ -341,6 +350,7 @@ isQueued pr = case approval pr of
     IncorrectBaseBranch -> False
     Conflicted _ _ -> False
     Integrated _ _ -> False
+    Promoted -> False
 
 -- Returns whether a pull request is in the process of being integrated (pending
 -- build results).
@@ -355,6 +365,7 @@ isInProgress pr = case approval pr of
       BuildPending   -> True
       BuildSucceeded -> False
       BuildFailed _  -> False
+    Promoted -> False
 
 -- Return whether the given commit is, or in this approval cycle ever was, an
 -- integration candidate of this pull request.
@@ -363,6 +374,12 @@ wasIntegrationAttemptFor commit pr = case integrationStatus pr of
   Integrated candidate _buildStatus -> commit `elem` (candidate : integrationAttempts pr)
   _                                 -> commit `elem` (integrationAttempts pr)
 
+integratedPullRequests :: ProjectState -> [PullRequestId]
+integratedPullRequests = filterPullRequestsBy $ isIntegrated . integrationStatus
+  where
+  isIntegrated (Integrated _ _) = True
+  isIntegrated _                = False
+
 -- Returns the pull requests that have not been integrated yet, in order of
 -- ascending id.
 unintegratedPullRequests :: ProjectState -> [PullRequestId]