diff --git a/src/Project.hs b/src/Project.hs index bdadb3ba..ac8fa7e9 100644 --- a/src/Project.hs +++ b/src/Project.hs @@ -24,6 +24,7 @@ module Project integratedPullRequests, unfailedIntegratedPullRequests, unfailedIntegratedPullRequestsBefore, + speculativelyFailedPullRequests, candidatePullRequests, classifyPullRequest, classifyPullRequests, @@ -394,6 +395,17 @@ wasIntegrationAttemptFor commit pr = case integrationStatus pr of integratedPullRequests :: ProjectState -> [PullRequestId] integratedPullRequests = filterPullRequestsBy $ isIntegrated . integrationStatus +-- | lists all PR ids that are speculative failures +speculativelyFailedPullRequests :: ProjectState -> [PullRequestId] +speculativelyFailedPullRequests state + = map fst + $ filter (isFailedIntegrated . integrationStatus . snd) + $ dropWhile (not . isUnfailedIntegrated . integrationStatus . snd) + [ (pid, pr) + | pid <- integratedPullRequests state + , Just pr <- [lookupPullRequest pid state] + ] + unfailedIntegratedPullRequests :: ProjectState -> [PullRequestId] unfailedIntegratedPullRequests = filterPullRequestsBy $ isUnfailedIntegrated . integrationStatus @@ -463,6 +475,10 @@ isIntegrated :: IntegrationStatus -> Bool isIntegrated (Integrated _ _) = True isIntegrated _ = False +isFailedIntegrated :: IntegrationStatus -> Bool +isFailedIntegrated (Integrated _ (BuildFailed _)) = True +isFailedIntegrated _ = False + isUnfailedIntegrated :: IntegrationStatus -> Bool isUnfailedIntegrated (Integrated _ buildStatus) = case buildStatus of BuildPending -> True diff --git a/src/WebInterface.hs b/src/WebInterface.hs index cb999b62..069d1680 100644 --- a/src/WebInterface.hs +++ b/src/WebInterface.hs @@ -33,7 +33,7 @@ import qualified Data.Text as Text import Format (format) import Git (Sha(..)) import Project (Approval (..), BuildStatus (..), IntegrationStatus (..), Owner, ProjectInfo, - ProjectState, PullRequest (integrationStatus)) + ProjectState, PullRequest (integrationStatus), speculativelyFailedPullRequests) import Types (PullRequestId (..), Username (..)) import qualified Project @@ -151,27 +151,30 @@ viewProjectQueues info state = do let pullRequests :: [(PullRequestId, PullRequest, Project.PullRequestStatus)] pullRequests = Project.classifyPullRequests state - filterPrs predicate = sortOn (\(_, pr, _) -> approvalOrder <$> Project.approval pr) - $ filter (\(_, _, status) -> predicate status) pullRequests - - let building = filterPrs prPending + speculativelyFailedIds = speculativelyFailedPullRequests state + sortPrs = sortOn (\(_, pr, _) -> approvalOrder <$> Project.approval pr) + filterPrs predicate = filter (\(_, _, status) -> predicate status) pullRequests + allFailed = filterPrs prFailed + failed = filter (\(pid,_,_) -> pid `notElem` speculativelyFailedIds) allFailed + speculativelyFailed = filter (\(pid,_,_) -> pid `elem` speculativelyFailedIds) allFailed + building = filterPrs prPending + ++ speculativelyFailed + approved = filterPrs (== Project.PrStatusApproved) + awaitingApproval = filterPrs (== Project.PrStatusAwaitingApproval) h2 "Building" if null building then p "There are no builds in progress at the moment." - else viewList viewPullRequestWithApproval info building + else viewList viewPullRequestWithApproval info (sortPrs building) - let approved = filterPrs (== Project.PrStatusApproved) unless (null approved) $ do h2 "Approved" - viewList viewPullRequestWithApproval info approved + viewList viewPullRequestWithApproval info (sortPrs approved) - let failed = filterPrs prFailed unless (null failed) $ do h2 "Failed" -- TODO: Also render failure reason: conflicted or build failed. - viewList viewPullRequestWithApproval info failed + viewList viewPullRequestWithApproval info (sortPrs failed) - let awaitingApproval = reverse $ filterPrs (== Project.PrStatusAwaitingApproval) unless (null awaitingApproval) $ do h2 "Awaiting approval" viewList viewPullRequest info awaitingApproval