Skip to content

Commit

Permalink
refactor: use getIntegrationCandidates
Browse files Browse the repository at this point in the history 
in favour of getIntegrationCandidate
  • Loading branch information
@rudymatela
rudymatela committed Jul 19, 2022
1 parent 7cc7fe8 commit 08acc5c
Show file tree
Hide file tree
Showing 3 changed files with 43 additions and 49 deletions.
9 changes: 2 additions & 7 deletions src/Project.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,6 @@ module Project
deletePullRequest,
emptyProjectState,
existsPullRequest,
getIntegrationCandidate,
getIntegrationCandidates,
getQueuePosition,
insertPullRequest,
Expand All @@ -55,7 +54,7 @@ import Data.ByteString (readFile)
import Data.ByteString.Lazy (writeFile)
import Data.IntMap.Strict (IntMap)
import Data.List (intersect, nub, sortBy)
import Data.Maybe (isJust, listToMaybe)
import Data.Maybe (isJust)
import Data.Text (Text)
import GHC.Generics
import Git (Branch (..), BaseBranch (..), Sha (..), GitIntegrationFailure (..))
Expand Down Expand Up @@ -272,11 +271,7 @@ setIntegrationStatus pr newStatus = updatePullRequest pr changeIntegrationStatus
}
_notIntegrated -> pullRequest { integrationStatus = newStatus }

-- Gets the first integration candidate
getIntegrationCandidate :: ProjectState -> Maybe (PullRequestId, PullRequest)
getIntegrationCandidate = listToMaybe . getIntegrationCandidates

-- Same as 'integratedPullRequests' but paired with the underlying object.
-- Same as 'integratedPullRequests' but paired with the underlying objects.
getIntegrationCandidates :: ProjectState -> [(PullRequestId, PullRequest)]
getIntegrationCandidates state =
[ (pullRequestId, candidate)
Expand Down
49 changes: 24 additions & 25 deletions tests/EventLoopSpec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,6 @@ import Control.Monad (forM_, void, when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Logger (runNoLoggingT)
import Data.Map (Map)
import Data.Maybe (isJust)
import Data.Set (Set)
import Data.Text (Text)
import Prelude hiding (appendFile, writeFile)
Expand Down Expand Up @@ -469,7 +468,7 @@ eventLoopSpec = parallel $ do

-- Extract the sha of the rebased commit from the project state.
let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest

-- The rebased commit should have been pushed to the remote repository
Expand Down Expand Up @@ -529,7 +528,7 @@ eventLoopSpec = parallel $ do

-- Extract the sha of the rebased commit from the project state.
let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest

-- The rebased commit should have been pushed to the remote repository
Expand Down Expand Up @@ -570,7 +569,7 @@ eventLoopSpec = parallel $ do
]

let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest

void $ runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]
Expand Down Expand Up @@ -630,7 +629,7 @@ eventLoopSpec = parallel $ do
]

let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest

void $ runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]
Expand Down Expand Up @@ -694,7 +693,7 @@ eventLoopSpec = parallel $ do

-- Extract the sha of the rebased commit from the project state.
let
Just (_prId, pullRequest6) = Project.getIntegrationCandidate state
[(_prId, pullRequest6)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest6

-- The rebased commit should have been pushed to the remote repository
Expand All @@ -704,7 +703,7 @@ eventLoopSpec = parallel $ do
-- Repeat for the other pull request, which should be the candidate by
-- now.
let
Just (_prId, pullRequest4) = Project.getIntegrationCandidate state'
[(_prId, pullRequest4)] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest4
void $ runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

Expand Down Expand Up @@ -739,13 +738,13 @@ eventLoopSpec = parallel $ do
]

let
Just (_prId, pullRequest6) = Project.getIntegrationCandidate state
[(_prId, pullRequest6)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest6

state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

let
Just (_prId, pullRequest4) = Project.getIntegrationCandidate state'
[(_prId, pullRequest4)] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest4
void $ runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

Expand Down Expand Up @@ -828,7 +827,7 @@ eventLoopSpec = parallel $ do

-- The second pull request should still be pending, awaiting the build
-- result.
let Just (prId, pullRequest4) = Project.getIntegrationCandidate state
let [(prId, pullRequest4)] = Project.getIntegrationCandidates state
prId `shouldBe` pr4
let Integrated _ buildStatus = Project.integrationStatus pullRequest4
buildStatus `shouldBe` BuildPending
Expand Down Expand Up @@ -868,23 +867,23 @@ eventLoopSpec = parallel $ do
-- Extract the sha of the rebased commit from the project state, and
-- tell the loop that building the commit succeeded.
let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

-- The push should have failed, hence there should still be an
-- integration candidate.
Project.getIntegrationCandidate state' `shouldSatisfy` isJust
Project.getIntegrationCandidates state' `shouldSatisfy` (not . null)

-- Again notify build success, now for the new commit.
let
Just (_prId, pullRequest') = Project.getIntegrationCandidate state'
[(_prId, pullRequest')] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest'
state'' <- runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

-- After the second build success, the pull request should have been
-- integrated properly, so there should not be a new candidate.
Project.getIntegrationCandidate state'' `shouldBe` Nothing
Project.getIntegrationCandidates state'' `shouldBe` []

history `shouldBe`
[ "* Merge #6"
Expand Down Expand Up @@ -923,13 +922,13 @@ eventLoopSpec = parallel $ do
git ["push", "origin", refSpec (c4, masterBranch)]

let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

-- Again notify build success, now for the new commit.
let
Just (_prId, pullRequest') = Project.getIntegrationCandidate state'
[(_prId, pullRequest')] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest'
void $ runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

Expand Down Expand Up @@ -999,13 +998,13 @@ eventLoopSpec = parallel $ do
git ["push", "origin", refSpec (Git.TagName "v2")]

let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

-- Again notify build success, now for the new commit.
let
Just (_prId, pullRequest') = Project.getIntegrationCandidate state'
[(_prId, pullRequest')] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest'
void $ runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

Expand Down Expand Up @@ -1072,7 +1071,7 @@ eventLoopSpec = parallel $ do
-- Extract the sha of the rebased commit from the project state, and
-- tell the loop that building the commit succeeded.
let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
void $ runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

Expand Down Expand Up @@ -1114,13 +1113,13 @@ eventLoopSpec = parallel $ do
-- Extract the sha of the rebased commit from the project state, and
-- tell the loop that building the commit succeeded.
let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

-- Again notify build success, now for the new commit.
let
Just (_prId, pullRequest') = Project.getIntegrationCandidate state'
[(_prId, pullRequest')] = Project.getIntegrationCandidates state'
Project.Integrated rebasedSha' _ = Project.integrationStatus pullRequest'
void $ runLoop state' [Logic.BuildStatusChanged rebasedSha' BuildSucceeded]

Expand Down Expand Up @@ -1168,14 +1167,14 @@ eventLoopSpec = parallel $ do
-- tell the loop that building the commit succeeded.

let
Just (_prId, pullRequest) = Project.getIntegrationCandidate state
[(_prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest
state' <- runLoop state [Logic.BuildStatusChanged rebasedSha BuildSucceeded]

--The pull request should not be integrated. Moreover, the presence of
--orphan fixups should make the PR ineligible for being a candidate for integration.
--That is, we expect no candidates for integration.
Project.getIntegrationCandidate state' `shouldBe` Nothing
Project.getIntegrationCandidates state' `shouldBe` []

-- Here we expect that the fixup commit is not present.
history `shouldBe`
Expand Down Expand Up @@ -1205,7 +1204,7 @@ eventLoopSpec = parallel $ do
]

let
Just (prId, pullRequest) = Project.getIntegrationCandidate state
[(prId, pullRequest)] = Project.getIntegrationCandidates state
Project.Integrated rebasedSha _ = Project.integrationStatus pullRequest

prId `shouldBe` pr8
Expand All @@ -1218,7 +1217,7 @@ eventLoopSpec = parallel $ do
Logic.CommentAdded pr6 "rachael" "@bot merge"
]

Project.getIntegrationCandidate state' `shouldBe` Nothing
Project.getIntegrationCandidates state' `shouldBe` []

let Just pullRequest' = Project.lookupPullRequest pr6 state'
Project.integrationStatus pullRequest' `shouldBe`
Expand Down
34 changes: 17 additions & 17 deletions tests/Spec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1051,7 +1051,7 @@ main = hspec $ do
, resultPush = [PushRejected "test"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
(prId, pullRequest) = fromJust $ Project.getIntegrationCandidate state'
[(prId, pullRequest)] = Project.getIntegrationCandidates state'
Project.integrationStatus pullRequest `shouldBe` Project.Integrated (Sha "38c") Project.BuildPending
prId `shouldBe` PullRequestId 1
actions `shouldBe`
Expand All @@ -1072,7 +1072,7 @@ main = hspec $ do
, resultPush = [PushRejected "test"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
(prId, pullRequest) = fromJust $ Project.getIntegrationCandidate state'
[(prId, pullRequest)] = Project.getIntegrationCandidates state'
Project.integrationStatus pullRequest `shouldBe` Project.Integrated (Sha "38c") Project.BuildPending
prId `shouldBe` PullRequestId 2
actions `shouldBe`
Expand All @@ -1099,10 +1099,10 @@ main = hspec $ do
}
results = defaultResults { resultIntegrate = [Right (Sha "38e")] }
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
candidate = Project.getIntegrationCandidate state'
candidates = Project.getIntegrationCandidates state'
-- After a successful push, the candidate should be gone.
candidate `shouldBe` Nothing
actions `shouldBe` [ATryPromote (Branch "results/rachael") (Sha "38d")]
candidates `shouldBe` []
actions `shouldBe` [ATryPromote (Branch "results/rachael") (Sha "38d")]

it "pushes and tags with a new version after a successful build (merge and tag)" $ do
let
Expand All @@ -1126,10 +1126,10 @@ main = hspec $ do
, resultGetChangelog = [Just "changelog"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
candidate = Project.getIntegrationCandidate state'
candidates = Project.getIntegrationCandidates state'
-- After a successful push, the candidate should be gone.
candidate `shouldBe` Nothing
actions `shouldBe`
candidates `shouldBe` []
actions `shouldBe`
[ ATryPromoteWithTag (Branch "results/rachael") (Sha "38d") (TagName "v2")
(TagMessage "v2\n\nchangelog")
, ALeaveComment (PullRequestId 1)
Expand Down Expand Up @@ -1158,10 +1158,10 @@ main = hspec $ do
, resultGetChangelog = [Just "changelog"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
candidate = Project.getIntegrationCandidate state'
candidates = Project.getIntegrationCandidates state'
-- After a successful push, the candidate should be gone.
candidate `shouldBe` Nothing
actions `shouldBe`
candidates `shouldBe` []
actions `shouldBe`
[ ATryPromoteWithTag (Branch "results/rachael") (Sha "38d") (TagName "v2")
(TagMessage "v2 (autodeploy)\n\nchangelog")
, ALeaveComment (PullRequestId 1)
Expand All @@ -1188,10 +1188,10 @@ main = hspec $ do
results = defaultResults { resultIntegrate = [Right (Sha "38e")]
, resultGetLatestVersion = [Left (TagName "abcdef")] }
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
candidate = Project.getIntegrationCandidate state'
candidates = Project.getIntegrationCandidates state'
-- After a successful push, the candidate should be gone.
candidate `shouldBe` Nothing
actions `shouldBe` [ ALeaveComment (PullRequestId 1) "@deckard Sorry, I could not tag your PR. The previous tag `abcdef` seems invalid"
candidates `shouldBe` []
actions `shouldBe` [ ALeaveComment (PullRequestId 1) "@deckard Sorry, I could not tag your PR. The previous tag `abcdef` seems invalid"
, ATryPromote (Branch "results/rachael") (Sha "38d")]


Expand Down Expand Up @@ -1221,7 +1221,7 @@ main = hspec $ do
, resultPush = [PushRejected "test"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
(_, pullRequest') = fromJust $ Project.getIntegrationCandidate state'
[(_, pullRequest')] = Project.getIntegrationCandidates state'

Project.integrationStatus pullRequest' `shouldBe` Project.Integrated (Sha "38e") Project.BuildPending
Project.integrationAttempts pullRequest' `shouldBe` [Sha "38d"]
Expand Down Expand Up @@ -1258,7 +1258,7 @@ main = hspec $ do
, resultGetChangelog = [Just "changelog"]
}
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
(_, pullRequest') = fromJust $ Project.getIntegrationCandidate state'
[(_, pullRequest')] = Project.getIntegrationCandidates state'

Project.integrationStatus pullRequest' `shouldBe` Project.Integrated (Sha "38e") Project.BuildPending
Project.integrationAttempts pullRequest' `shouldBe` [Sha "38d"]
Expand Down Expand Up @@ -1352,7 +1352,7 @@ main = hspec $ do
-- Proceeding should pick the next pull request as candidate.
results = defaultResults { resultIntegrate = [Right (Sha "38e")] }
(state', actions) = runActionCustom results $ Logic.proceedUntilFixedPoint state
Just (cId, _candidate) = Project.getIntegrationCandidate state'
[(cId, _candidate)] = Project.getIntegrationCandidates state'
cId `shouldBe` PullRequestId 2
actions `shouldBe`
[ ATryPromote (Branch "results/leon") (Sha "38d")
Expand Down

0 comments on commit 08acc5c

Please sign in to comment.