From 2933f17dda123ccfe78a8b4f678e536acc0223e1 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 9 Apr 2023 22:04:12 +0100
Subject: Refactor submitting builds for issues

So that the code may be used for an individual issue.
---
 guix-qa-frontpage/manage-builds.scm | 144 ++++++++++++++++++++----------------
 1 file changed, 81 insertions(+), 63 deletions(-)

(limited to 'guix-qa-frontpage')

diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm
index ada9591..77514c5 100644
--- a/guix-qa-frontpage/manage-builds.scm
+++ b/guix-qa-frontpage/manage-builds.scm
@@ -14,6 +14,8 @@
 
             builds-missing-for-derivation-changes?
 
+            submit-builds-for-issue
+
             start-submit-patch-builds-thread
             start-submit-branch-builds-thread
             start-submit-master-branch-system-tests-thread))
@@ -26,6 +28,75 @@
     "powerpc64le-linux"
     "i586-gnu"))
 
+(define* (submit-builds-for-issue
+          database
+          build-coordinator
+          guix-data-service
+          issue-number
+          #:key priority
+          build-limit)
+  (simple-format
+   #t
+   "considering submitting builds for issue ~A\n"
+   issue-number)
+
+  (let ((derivation-changes-url
+         (and=>
+          (get-issue-branch-base-and-target-refs issue-number)
+          (lambda (base-and-target-refs)
+            (patch-series-derivation-changes-url
+             base-and-target-refs
+             #:systems %systems-to-submit-builds-for)))))
+
+    (if derivation-changes-url
+        (let ((derivation-changes-data
+               change-details
+               (with-exception-handler
+                   (lambda (exn)
+                     (simple-format
+                      (current-error-port)
+                      "failed fetching derivation changes for issue ~A: ~A\n"
+                      issue-number
+                      exn)
+
+                     (values #f #f))
+                 (lambda ()
+                   (with-sqlite-cache
+                    database
+                    'derivation-changes
+                    derivation-changes
+                    #:args
+                    (list derivation-changes-url)
+                    #:ttl (* 60 20)))
+                 #:unwind? #t)))
+
+          (when derivation-changes-data
+            (let ((target-commit
+                   (assoc-ref
+                    (assoc-ref
+                     (assoc-ref change-details
+                                "revisions")
+                     "target")
+                    "commit")))
+
+              (submit-builds-for-category build-coordinator
+                                          guix-data-service
+                                          'issue
+                                          issue-number
+                                          derivation-changes-data
+                                          target-commit
+                                          #:build-limit build-limit
+                                          #:priority priority
+                                          #:build-count-priority-penalty
+                                          (lambda (build-count)
+                                            (cond
+                                             ((< build-count 10)  0)
+                                             ((< build-count 100) 50)
+                                             ((< build-count 300) 100)
+                                             (else                150)))))))
+        (simple-format #t "no derivation changes url for issue ~A\n"
+                       issue-number))))
+
 (define* (start-submit-patch-builds-thread database
                                            build-coordinator
                                            guix-data-service
@@ -47,69 +118,16 @@
       (n-par-for-each
        4
        (match-lambda
-         ((issue-number . series)
-          (simple-format #t
-                         "considering submitting builds for issue ~A\n"
-                         issue-number)
-
-          (let ((derivation-changes-url
-                 (and=>
-                  (get-issue-branch-base-and-target-refs issue-number)
-                  (lambda (base-and-target-refs)
-                    (patch-series-derivation-changes-url
-                     base-and-target-refs
-                     #:systems %systems-to-submit-builds-for)))))
-
-            (if derivation-changes-url
-                (let ((derivation-changes-data
-                       change-details
-                       (with-exception-handler
-                           (lambda (exn)
-                             (simple-format
-                              (current-error-port)
-                              "failed fetching derivation changes for issue ~A: ~A\n"
-                              issue-number
-                              exn)
-
-                             (values #f #f))
-                         (lambda ()
-                           (with-sqlite-cache
-                            database
-                            'derivation-changes
-                            derivation-changes
-                            #:args
-                            (list derivation-changes-url)
-                            #:ttl (* 60 20)))
-                         #:unwind? #t)))
-
-                  (when derivation-changes-data
-                    (let ((target-commit
-                           (assoc-ref
-                            (assoc-ref
-                             (assoc-ref change-details
-                                        "revisions")
-                             "target")
-                            "commit")))
-
-                      (submit-builds-for-category build-coordinator
-                                                  guix-data-service
-                                                  'issue
-                                                  issue-number
-                                                  derivation-changes-data
-                                                  target-commit
-                                                  #:build-limit
-                                                  (* (length %systems-to-submit-builds-for)
-                                                     600)
-                                                  #:priority priority-for-change
-                                                  #:build-count-priority-penalty
-                                                  (lambda (build-count)
-                                                    (cond
-                                                     ((< build-count 10)  0)
-                                                     ((< build-count 100) 50)
-                                                     ((< build-count 300) 100)
-                                                     (else                150)))))))
-                (simple-format #t "no derivation changes url for issue ~A\n"
-                               issue-number)))))
+         ((issue-number . _)
+          (submit-builds-for-issue
+           database
+           build-coordinator
+           guix-data-service
+           issue-number
+           #:priority priority-for-change
+           #:build-limit
+           (* (length %systems-to-submit-builds-for)
+              600))))
        (take series series-count))))
 
   (call-with-new-thread
-- 
cgit v1.2.3