diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-07-05 11:24:12 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-07-05 11:24:12 +0100 |
| commit | 05edc13c9b82f65f852a2643f3d561277a6f0f54 (patch) | |
| tree | 51b629995f43ce379316be7cb36a4f6feb5d9ff4 /guix-qa-frontpage/manage-builds.scm | |
| parent | f3e888bf34c8fdc5ef7cee67054c159264dee4a7 (diff) | |
| download | qa-frontpage-05edc13c9b82f65f852a2643f3d561277a6f0f54.tar qa-frontpage-05edc13c9b82f65f852a2643f3d561277a6f0f54.tar.gz | |
Add a new package changes page
And make some refactoring to make this easier.
Diffstat (limited to 'guix-qa-frontpage/manage-builds.scm')
| -rw-r--r-- | guix-qa-frontpage/manage-builds.scm | 41 |
1 files changed, 23 insertions, 18 deletions
diff --git a/guix-qa-frontpage/manage-builds.scm b/guix-qa-frontpage/manage-builds.scm index a83d8d6..d1d797a 100644 --- a/guix-qa-frontpage/manage-builds.scm +++ b/guix-qa-frontpage/manage-builds.scm @@ -1,5 +1,6 @@ (define-module (guix-qa-frontpage manage-builds) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-43) #:use-module (srfi srfi-71) #:use-module (ice-9 match) #:use-module (ice-9 streams) @@ -56,13 +57,12 @@ (and=> (get-issue-branch-base-and-target-refs issue-number) (lambda (base-and-target-refs) - (revision-derivation-changes-url + (compare-package-derivations-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 @@ -71,12 +71,12 @@ issue-number exn) - (values #f #f)) + #f) (lambda () (with-sqlite-cache database 'derivation-changes - revision-derivation-changes + compare-package-derivations #:args (list derivation-changes-url) #:ttl (* 60 20))) @@ -86,7 +86,7 @@ (let ((target-commit (assoc-ref (assoc-ref - (assoc-ref change-details + (assoc-ref derivation-changes-data "revisions") "target") "commit"))) @@ -208,13 +208,12 @@ (target . ,branch-commit))) (derivation-changes-url - (revision-derivation-changes-url + (compare-package-derivations-url revisions #:systems %systems-to-submit-builds-for))) (if derivation-changes-url (let ((derivation-changes-data - change-details (with-exception-handler (lambda (exn) (simple-format @@ -223,12 +222,12 @@ branch exn) - (values #f #f)) + #f) (lambda () (with-sqlite-cache database 'branch-derivation-changes - revision-derivation-changes + compare-package-derivations #:args (list derivation-changes-url) #:ttl 0)) @@ -238,7 +237,7 @@ (let ((target-commit (assoc-ref (assoc-ref - (assoc-ref change-details + (assoc-ref derivation-changes-data "revisions") "target") "commit"))) @@ -406,10 +405,13 @@ #t #f) #f)) - (append-map! (lambda (package) - (vector->list - (assoc-ref package "target"))) - derivation-changes))) + (vector-fold + (lambda (_ result package) + (append! result + (vector->list + (assoc-ref package "target")))) + '() + derivation-changes))) (define* (submit-builds-for-category build-coordinator @@ -456,10 +458,13 @@ build-ids-to-keep-set)) (let loop ((changes - (append-map! (lambda (package) - (vector->list - (assoc-ref package "target"))) - derivation-changes)) + (vector-fold + (lambda (_ result package) + (append! result + (vector->list + (assoc-ref package "target")))) + '() + (assoc-ref derivation-changes "derivation_changes"))) (builds-to-submit-details '()) (build-ids-to-keep-set (set))) |