Skip to content

Commit b7656ef

Browse files
L7R7L7R7
committed
Switch to queued processing for updating merge requests
1 parent 6e26ae1 commit b7656ef

File tree

5 files changed

+81
-56
lines changed

5 files changed

+81
-56
lines changed

‎src/Effects.hs‎

Lines changed: 15 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ module Effects
2727
-- * MergeRequest
2828
getOpenMergeRequests,
2929
getOpenMergeRequestsForGroup,
30+
getOpenMergeRequestsForGroupQueued,
3031
enableSourceBranchDeletionAfterMrMerge,
3132
setSuccessfulPipelineRequirementForMerge,
3233
unsetSuccessfulPipelineRequirementForMerge,
@@ -188,6 +189,20 @@ getOpenMergeRequests project maybeAuthorIs recheckMergeStatus = do
188189
let template = [uriTemplate|/api/v4/projects/{projectId}/merge_requests?state=opened&author_id={authorId}&with_merge_status_recheck={recheckMergeStatus}|]
189190
fetchDataPaginated template [("projectId", (stringValue . show) project), ("authorId", (stringValue . show) i), ("recheckMergeStatus", recheckMergeStatusToBooleanValue recheckMergeStatus)]
190191

192+
getOpenMergeRequestsForGroupQueued :: Maybe AuthorIs -> Maybe SearchTerm -> MergeStatusRecheck -> (MergeRequest -> App (Either UpdateError (ProcessResult a))) -> App (Either UpdateError [a])
193+
getOpenMergeRequestsForGroupQueued maybeAuthorIs maybeSearchTerm recheckMergeStatus action = do
194+
grp <- asks groupId
195+
let template = [uriTemplate|/api/v4/groups/{groupId}/merge_requests?state=opened{&author_id,search,with_merge_status_recheck}|]
196+
vars =
197+
mconcat
198+
[ [("groupId", (stringValue . show) grp)],
199+
foldMap (\(AuthorIs i) -> [("author_id", (stringValue . show) i)]) maybeAuthorIs,
200+
foldMap (\(SearchTerm s) -> [("search", stringValue s)]) maybeSearchTerm,
201+
[("with_merge_status_recheck", recheckMergeStatusToBooleanValue recheckMergeStatus)]
202+
]
203+
queueConfig = QueueConfig {parallelism = 10, bufferSize = 250} -- todo: make these configurable
204+
fetchDataQueued template vars queueConfig action
205+
191206
getOpenMergeRequestsForGroup :: Maybe AuthorIs -> Maybe SearchTerm -> MergeStatusRecheck -> App (Either UpdateError [MergeRequest])
192207
getOpenMergeRequestsForGroup maybeAuthorIs maybeSearchTerm recheckMergeStatus = do
193208
grp <- asks groupId

‎src/Projects.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -140,7 +140,7 @@ enableSuccessfulPipelineForMergeRequirement execution =
140140

141141
projectHasCi :: Either UpdateError Project -> App (Either UpdateError Bool)
142142
projectHasCi (Left err) = pure $ Left err
143-
projectHasCi (Right (Project pId _ _ (Just ref) _ _ _ _ _ _ _ _ _ _)) = hasCi pId ref
143+
projectHasCi (Right (Project pId _ _ (Just ref) _ _ _ _ _ _ _ _ _ _ _)) = hasCi pId ref
144144
projectHasCi (Right _) = pure $ Right False -- no default branch, no CI
145145

146146
configureOption :: Execution -> Id Project -> Either UpdateError Bool -> App (Either UpdateError ())

‎src/UpdateMergeRequests.hs‎

Lines changed: 42 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
1-
{-# LANGUAGE LambdaCase #-}
21
{-# LANGUAGE OverloadedStrings #-}
2+
{-# LANGUAGE TupleSections #-}
33

44
module UpdateMergeRequests
55
( updateMergeRequests,
@@ -10,6 +10,7 @@ import App (App)
1010
import Config.Types
1111
import Data.Text (isInfixOf, strip, stripPrefix, toLower)
1212
import Effects
13+
import Gitlab.Client.Queue.MTL (ProcessResult (..), UpdateError)
1314
import Gitlab.Lib (Id)
1415
import Gitlab.MergeRequest
1516
import Gitlab.Project (Project)
@@ -27,57 +28,66 @@ updateMergeRequests _ (Merge _) _ Nothing _ Execute =
2728
write "I don't think you want to blindly merge all merge requests for this group. Consider adding a filter. Exiting now."
2829
updateMergeRequests projectExcludes action authorIs maybeSearchTerms recheckMergeStatus execute = do
2930
let searchTerm' = either id (\(SearchTermTitle s) -> SearchTerm s) <$> maybeSearchTerms
30-
getOpenMergeRequestsForGroup authorIs searchTerm' recheckMergeStatus >>= \case
31-
Left err -> write $ show err
32-
Right [] -> write "no MRs to process"
33-
Right allMergeRequests -> do
34-
let titleFilter mr = case maybeSearchTerms of
35-
Just (Right (SearchTermTitle s)) -> toLower (toText s) `isInfixOf` toLower (mergeRequestTitle mr)
36-
_ -> True
37-
filteredMergeRequests = filter (\mr -> titleFilter mr && mergeRequestProjectId mr `notElem` projectExcludes) allMergeRequests
38-
case filteredMergeRequests of
39-
[] -> write "no MRs to process after applying filters"
40-
mergeRequests -> forM_ mergeRequests $ \mr -> do
41-
write $ "processing MR #" <> show (mergeRequestIid mr) <> " in Project #" <> show (mergeRequestProjectId mr) <> " with state " <> show (mergeRequestDetailedMergeStatus mr) <> ": " <> mergeRequestTitle mr
42-
res <- performAction mr
43-
case res of
44-
Left err -> write $ "failed to update merge request: " <> show err
45-
Right _ -> pure ()
31+
res <- getOpenMergeRequestsForGroupQueued authorIs searchTerm' recheckMergeStatus $ \mr -> do
32+
if titleFilter mr && excludeFilter mr
33+
then do
34+
(txt, res) <- performAction mr
35+
pure $ PrintLinesWithResult (mconcat (mrTextLine mr <> maybe [] (\t -> [" >> ", t]) txt) :| []) () <$ res
36+
else pure $ Right Empty
37+
case res of
38+
Left err -> write $ "failed to update merge requests: " <> show err
39+
Right [] -> write "no merge requests to process"
40+
Right updates -> write $ show (length updates) <> " merge requests"
4641
where
42+
mrTextLine mr =
43+
[ "#",
44+
show (mergeRequestIid mr),
45+
" in Project #",
46+
show (mergeRequestProjectId mr),
47+
" with state ",
48+
show (mergeRequestDetailedMergeStatus mr),
49+
": ",
50+
mergeRequestTitle mr
51+
]
52+
titleFilter mr = case maybeSearchTerms of
53+
Just (Right (SearchTermTitle s)) -> toLower (toText s) `isInfixOf` toLower (mergeRequestTitle mr)
54+
_ -> True
55+
excludeFilter mr = mergeRequestProjectId mr `notElem` projectExcludes
56+
performAction :: MergeRequest -> App (Maybe Text, Either UpdateError ())
4757
performAction mr =
4858
let pId = mergeRequestProjectId mr
4959
in case action of
50-
List -> pure $ Right ()
60+
List -> pure (Nothing, Right ())
5161
Rebase -> rebaseAction pId (mergeRequestIid mr)
5262
(Merge mergeCiOption) -> case detailedMergeStatusToDecision (mergeRequestDetailedMergeStatus mr) of
5363
MergeShouldWork -> mergeAction pId (mergeRequestIid mr) mergeCiOption
5464
MergeMayWork -> mergeAttemptAction pId (mergeRequestIid mr) mergeCiOption
5565
MergeWontWork -> mergeWontWorkAction (mergeRequestDetailedMergeStatus mr)
5666
SetToDraft ->
5767
if mergeRequestWip mr
58-
then Right () <$ write "merge request is already in state \"Draft\""
68+
then pure (Just "merge request is already in state \"Draft\"", Right ())
5969
else setToDraftAction pId (mergeRequestIid mr) (mergeRequestTitle mr)
6070
MarkAsReady ->
6171
if mergeRequestWip mr
6272
then markAsReadyAction pId (mergeRequestIid mr) (mergeRequestTitle mr)
63-
else Right () <$ write "merge request is already marked as ready"
73+
else pure (Just "merge request is already marked as ready", Right ())
6474

6575
(rebaseAction, mergeAction, mergeAttemptAction, mergeWontWorkAction, setToDraftAction, markAsReadyAction) = case execute of
6676
Execute ->
67-
( rebaseMergeRequest,
68-
mergeMergeRequest,
69-
mergeMergeRequest,
70-
\detailedStatus -> Right () <$ write ("The merge status is " <> show detailedStatus <> ", skipping the merge as it wouldn't succeed"),
71-
\pId mrIid mrTitle -> setMergeRequestTitle pId mrIid ("Draft: " <> mrTitle),
72-
\pId mrIid mrTitle -> setMergeRequestTitle pId mrIid (strip $ fromMaybe mrTitle (stripPrefix "Draft:" mrTitle))
77+
( \pId mId -> (Nothing,) <$> rebaseMergeRequest pId mId,
78+
\pId mId mco -> (Nothing,) <$> mergeMergeRequest pId mId mco,
79+
\pId mId mco -> (Nothing,) <$> mergeMergeRequest pId mId mco,
80+
\detailedStatus -> pure (Just $ "The merge status is " <> show detailedStatus <> ", skipping the merge as it wouldn't succeed", Right ()),
81+
\pId mrIid mrTitle -> (Nothing,) <$> setMergeRequestTitle pId mrIid ("Draft: " <> mrTitle),
82+
\pId mrIid mrTitle -> (Nothing,) <$> setMergeRequestTitle pId mrIid (strip $ fromMaybe mrTitle (stripPrefix "Draft:" mrTitle))
7383
)
7484
DryRun ->
75-
( \_ _ -> Right () <$ write "dry run. skipping rebase",
76-
\_ _ _ -> Right () <$ write "dry run. skipping merge",
77-
\_ _ _ -> Right () <$ write "dry run. skipping merge attempt",
78-
\detailedStatus -> Right () <$ write ("The merge status is " <> show detailedStatus <> ", skipping the merge as it wouldn't succeed"),
79-
\_ _ _ -> Right () <$ write "dry run. skipping draft toggle",
80-
\_ _ _ -> Right () <$ write "dry run. skipping draft toggle"
85+
( \_ _ -> pure (Just "dry run. skipping rebase", Right ()),
86+
\_ _ _ -> pure (Just "dry run. skipping merge", Right ()),
87+
\_ _ _ -> pure (Just "dry run. skipping merge attempt", Right ()),
88+
\detailedStatus -> pure (Just $ "The merge status is " <> show detailedStatus <> ", skipping the merge as it wouldn't succeed", Right ()),
89+
\_ _ _ -> pure (Just "dry run. skipping draft toggle", Right ()),
90+
\_ _ _ -> pure (Just "dry run. skipping draft toggle", Right ())
8191
)
8292

8393
-- | Depending on the merge status of a merge request, trying a merge may or may not make sense.

‎stack.yaml‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ packages:
55

66
extra-deps:
77
- github: L7R7/gitlab-api
8-
commit: e3bd8278e19154adcf17ecad293d8ef07c1f006b
8+
commit: 5cefe4d85180c31f927014bcc1b9b4f0b106d4a4
99
subdirs:
1010
- gitlab-api-http-client
1111
- gitlab-api-http-client-mtl

‎stack.yaml.lock‎

Lines changed: 22 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -9,66 +9,66 @@ packages:
99
pantry-tree:
1010
sha256: ba41d94e0da3f64b9883530667de2d8772e685776f7a9b56a08eecb3e1732c1c
1111
size: 323
12-
sha256: bf8390d23847c81b0d42e62daa81ca46aa513e87d307dcc1ba61e43866981760
13-
size: 23140
12+
sha256: 3a17d37c9b47a890bf1442542380b19ca258de80114a5acacab7bc6d463e1fa5
13+
size: 23468
1414
subdir: gitlab-api-http-client
15-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
15+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
1616
version: 0.0.0.1
1717
original:
1818
subdir: gitlab-api-http-client
19-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
19+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
2020
- completed:
2121
name: gitlab-api-http-client-mtl
2222
pantry-tree:
2323
sha256: aaa8533e8c0d775331eb6adf4be515ad6ce5085ae952ecf4cc4788f3e2432653
2424
size: 195
25-
sha256: bf8390d23847c81b0d42e62daa81ca46aa513e87d307dcc1ba61e43866981760
26-
size: 23140
25+
sha256: 3a17d37c9b47a890bf1442542380b19ca258de80114a5acacab7bc6d463e1fa5
26+
size: 23468
2727
subdir: gitlab-api-http-client-mtl
28-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
28+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
2929
version: 0.0.0.1
3030
original:
3131
subdir: gitlab-api-http-client-mtl
32-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
32+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
3333
- completed:
3434
name: gitlab-api-http-client-queued
3535
pantry-tree:
36-
sha256: 595d620bd2c0c8b9b4b744e612687e5cf1cfae87cb4aab9193a7e7de6f63185b
36+
sha256: ed326dfdfc0116ce4e56cdafed2d39eab4d28537b498486bbddac62e2dd17acb
3737
size: 200
38-
sha256: bf8390d23847c81b0d42e62daa81ca46aa513e87d307dcc1ba61e43866981760
39-
size: 23140
38+
sha256: 3a17d37c9b47a890bf1442542380b19ca258de80114a5acacab7bc6d463e1fa5
39+
size: 23468
4040
subdir: gitlab-api-http-client-queued
41-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
41+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
4242
version: 0.0.0.1
4343
original:
4444
subdir: gitlab-api-http-client-queued
45-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
45+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
4646
- completed:
4747
name: gitlab-api-http-client-queued-mtl
4848
pantry-tree:
4949
sha256: fe10096fc6ae5458d6871a15171ee249526883bfbc309589e5cec5da86dde036
5050
size: 207
51-
sha256: bf8390d23847c81b0d42e62daa81ca46aa513e87d307dcc1ba61e43866981760
52-
size: 23140
51+
sha256: 3a17d37c9b47a890bf1442542380b19ca258de80114a5acacab7bc6d463e1fa5
52+
size: 23468
5353
subdir: gitlab-api-http-client-queued-mtl
54-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
54+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
5555
version: 0.0.0.1
5656
original:
5757
subdir: gitlab-api-http-client-queued-mtl
58-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
58+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
5959
- completed:
6060
name: gitlab-api-types
6161
pantry-tree:
62-
sha256: 6cf943f17c29a9e25f786446d2d1192d469a1a7208114c40b0db39dcadc77448
62+
sha256: da72f92455a70bbd0e5248352dd61adf81b5525435ec2ad00e36be24c3a53236
6363
size: 725
64-
sha256: bf8390d23847c81b0d42e62daa81ca46aa513e87d307dcc1ba61e43866981760
65-
size: 23140
64+
sha256: 3a17d37c9b47a890bf1442542380b19ca258de80114a5acacab7bc6d463e1fa5
65+
size: 23468
6666
subdir: gitlab-api-types
67-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
67+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
6868
version: 0.0.0.1
6969
original:
7070
subdir: gitlab-api-types
71-
url: https://github.com/L7R7/gitlab-api/archive/e3bd8278e19154adcf17ecad293d8ef07c1f006b.tar.gz
71+
url: https://github.com/L7R7/gitlab-api/archive/5cefe4d85180c31f927014bcc1b9b4f0b106d4a4.tar.gz
7272
snapshots:
7373
- completed:
7474
sha256: 098936027eaa1ef14e2b8eb39d9933a973894bb70a68684a1bbf00730249879b

0 commit comments

Comments
 (0)