diff options
Diffstat (limited to 'guix-qa-frontpage/issue.scm')
| -rw-r--r-- | guix-qa-frontpage/issue.scm | 94 |
1 files changed, 48 insertions, 46 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index abcf96e..3cc9516 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -119,60 +119,59 @@ (get-issue-branch-base-and-target-refs number)) (derivation-changes-data - change-details (if base-and-target-refs (with-exception-handler (lambda (exn) - (values - (if (guix-data-service-error? exn) - `((exception . guix-data-service-invalid-parameters) - (invalid_query_parameters - . - ,(filter-map - (match-lambda - ((param . val) - (and=> - (assoc-ref val "invalid_value") - (lambda (value) - (let ((message - (assoc-ref val "message"))) - (cons - param - `((value . ,value) - (error - ;; Convert the HTML error messages - ;; to something easier to handle - . ,(cond - ((string-contains message - "failed to process revision") - 'failed-to-process-revision) - ((string-contains message - "yet to process revision") - 'yet-to-process-revision) - (else - 'unknown)))))))))) - (assoc-ref - (guix-data-service-error-response-body exn) - "query_parameters")))) - `((exception . ,(simple-format #f "~A" exn)))) - #f)) + (if (guix-data-service-error? exn) + `((exception . guix-data-service-invalid-parameters) + (invalid_query_parameters + . + ,(filter-map + (match-lambda + ((param . val) + (and=> + (assoc-ref val "invalid_value") + (lambda (value) + (let ((message + (assoc-ref val "message"))) + (cons + param + `((value . ,value) + (error + ;; Convert the HTML error messages + ;; to something easier to handle + . ,(cond + ((string-contains message + "failed to process revision") + 'failed-to-process-revision) + ((string-contains message + "yet to process revision") + 'yet-to-process-revision) + (else + 'unknown)))))))))) + (assoc-ref + (guix-data-service-error-response-body exn) + "query_parameters")))) + `((exception . ,(simple-format #f "~A" exn))))) (lambda () - (revision-derivation-changes - (revision-derivation-changes-url + (compare-package-derivations + (compare-package-derivations-url base-and-target-refs #:systems %systems-to-submit-builds-for))) #:unwind? #t) - (values #f #f))) - (derivation-changes-counts - (if change-details - (derivation-changes-counts + #f)) + (derivation-changes + (if (and derivation-changes-data + (not (assq-ref derivation-changes-data 'exception))) + (derivation-changes derivation-changes-data %systems-to-submit-builds-for) #f)) (builds-missing? - (if change-details + (if derivation-changes (builds-missing-for-derivation-changes? - derivation-changes-data) + (assoc-ref derivation-changes-data + "derivation_changes")) #t)) (comparison-details (and @@ -218,8 +217,10 @@ (values base-and-target-refs - derivation-changes-counts - change-details + derivation-changes + (and=> derivation-changes-data + (lambda (changes) + (alist-delete "derivation_changes" changes))) builds-missing? comparison-details))) @@ -261,7 +262,7 @@ #f) (lambda () (let ((base-and-target-refs - derivation-changes-counts + derivation-changes change-details builds-missing? comparison-details @@ -271,6 +272,7 @@ issue-data #:args (list (car series)) + #:version 2 #:ttl (/ frequency 2)))) (with-sqlite-cache @@ -278,7 +280,7 @@ 'issue-patches-overall-status (lambda (id) (issue-patches-overall-status - derivation-changes-counts + (assq-ref derivation-changes 'counts) builds-missing? (assq-ref (assq-ref series 'mumi) 'tags))) |