diff options
author | Christopher Baines <mail@cbaines.net> | 2024-04-23 11:02:59 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-04-23 11:02:59 +0100 |
commit | a5c41fb01a978a195a5a0d984863790916b6c8a0 (patch) | |
tree | 4a205425f75967a384f57808fc76c5c3525e79e0 /guix-qa-frontpage/manage-builds.scm | |
parent | 7156a36dec07d35c6b885a61727e34c98ebfdd68 (diff) | |
download | qa-frontpage-master.tar qa-frontpage-master.tar.gz |
Diffstat (limited to 'guix-qa-frontpage/manage-builds.scm')
-rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 90 |
1 files changed, 49 insertions, 41 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index b8b0189..1d9a512 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -390,47 +390,55 @@ branches)) (define (submit-branch-builds) - (let* ((branches - (take* - (filter - (match-lambda - ((name . details) - (->bool (assoc-ref details "issue_number")))) - (with-sqlite-cache - database - 'list-non-master-branches - list-non-master-branches - #:ttl 0)) - 2)) - (branch-names - (map car branches))) - - (let* ((branches-with-builds-previously-submitted - (select-from-builds-to-cancel-later - database - "branch")) - (branches-with-builds-to-cancel - (lset-difference - string=? - branches-with-builds-previously-submitted - branch-names))) - (unless (null? branches-with-builds-to-cancel) - (cancel-branch-builds branches-with-builds-to-cancel))) - - (let* ((substitute-availability - systems-with-low-substitute-availability - package-reproducibility - (with-sqlite-cache - database - 'master-branch-data - master-branch-data - #:ttl 6000 - #:version 2))) - (if (null? systems-with-low-substitute-availability) - (submit-builds branch-names) - (simple-format - (current-error-port) - "waiting for master branch substitutes before submitting branch builds\n"))))) + (let ((all-branches + (with-sqlite-cache + database + 'list-non-master-branches + list-non-master-branches + #:ttl 0))) + (if (assq-ref all-branches 'exception) + (simple-format + (current-error-port) + "unable to submit branch builds, exception in list-non-master-branches: ~A\n" + (assq-ref all-branches 'exception)) + + (let* ((branches + (take* + (filter + (match-lambda + ((name . details) + (->bool (assoc-ref details "issue_number")))) + all-branches) + 2)) + (branch-names + (map car branches))) + + (let* ((branches-with-builds-previously-submitted + (select-from-builds-to-cancel-later + database + "branch")) + (branches-with-builds-to-cancel + (lset-difference + string=? + branches-with-builds-previously-submitted + branch-names))) + (unless (null? branches-with-builds-to-cancel) + (cancel-branch-builds branches-with-builds-to-cancel))) + + (let* ((substitute-availability + systems-with-low-substitute-availability + package-reproducibility + (with-sqlite-cache + database + 'master-branch-data + master-branch-data + #:ttl 6000 + #:version 2))) + (if (null? systems-with-low-substitute-availability) + (submit-builds branch-names) + (simple-format + (current-error-port) + "waiting for master branch substitutes before submitting branch builds\n"))))))) (call-with-new-thread (lambda () |