diff options
| -rw-r--r-- | guix-qa-frontpage/branch.scm | 179 |
1 files changed, 85 insertions, 94 deletions
diff --git a/guix-qa-frontpage/branch.scm b/guix-qa-frontpage/branch.scm index d88e0e8..5e84df2 100644 --- a/guix-qa-frontpage/branch.scm +++ b/guix-qa-frontpage/branch.scm @@ -162,101 +162,92 @@ (apply max ordering-indexes))))))))))) (define* (branch-data branch-name) - (let* ((branch-commit - (get-commit - (string-append "origin/" branch-name))) - (merge-base - (get-git-merge-base - (get-commit "origin/master") - branch-commit)) - - (revisions - `((base . ,merge-base) - (target . ,branch-commit))) - - (up-to-date-with-master? - (let* ((master-revision - (get-latest-processed-branch-revision "master")) - (changes - (length - (revision-derivation-changes - (revision-derivation-changes-url - `((base . ,merge-base) - (target . ,master-revision)) - ;; TODO: Maybe do something smarter here? - #:systems '("x86_64-linux")))))) - `((up-to-date? . ,(< changes 3000)) - (changes . ,changes) - (master . ,master-revision)))) - - (derivation-changes-counts - (with-exception-handler - (lambda (exn) - (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 () - (let ((derivation-changes-data - change-details - (revision-derivation-changes - (revision-derivation-changes-url - revisions - #:systems %systems-to-submit-builds-for)))) - - (derivation-changes-counts - derivation-changes-data - %systems-to-submit-builds-for))) - #:unwind? #t)) - - (substitute-availability - (package-substitute-availability - (package-substitute-availability-url - branch-commit))) - - ;; TODO: Only include systems for which derivations are changed by - ;; this branch - (master-branch-systems-with-low-substitute-availability - (get-systems-with-low-substitute-availability - (master-branch-data) - (lset-difference - string=? - %systems-to-submit-builds-for - %systems-with-expected-low-substitute-availability)))) + (define branch-commit + (get-commit + (string-append "origin/" branch-name))) + + (if + branch-commit + (let* ((merge-base + (get-git-merge-base + (get-commit "origin/master") + branch-commit)) + + (revisions + `((base . ,merge-base) + (target . ,branch-commit))) + + (up-to-date-with-master? + (with-exception-handler + (lambda (exn) + (if (guix-data-service-error? exn) + (guix-data-service-error->sexp exn) + `((exception . ,(simple-format #f "~A" exn))))) + (lambda () + (let* ((master-revision + (get-latest-processed-branch-revision "master")) + (changes + (length + (revision-derivation-changes + (revision-derivation-changes-url + `((base . ,merge-base) + (target . ,master-revision)) + ;; TODO: Maybe do something smarter here? + #:systems '("x86_64-linux")))))) + `((up-to-date? . ,(< changes 3000)) + (changes . ,changes) + (master . ,master-revision)))) + #:unwind? #t)) - (values - revisions - derivation-changes-counts - substitute-availability - up-to-date-with-master? - master-branch-systems-with-low-substitute-availability))) + (derivation-changes-counts + (with-exception-handler + (lambda (exn) + (if (guix-data-service-error? exn) + (guix-data-service-error->sexp exn) + `((exception . ,(simple-format #f "~A" exn))))) + (lambda () + (let ((derivation-changes-data + change-details + (revision-derivation-changes + (revision-derivation-changes-url + revisions + #:systems %systems-to-submit-builds-for)))) + + (derivation-changes-counts + derivation-changes-data + %systems-to-submit-builds-for))) + #:unwind? #t)) + + (substitute-availability + (with-exception-handler + (lambda (exn) + (if (guix-data-service-error? exn) + (guix-data-service-error->sexp exn) + `((exception . ,(simple-format #f "~A" exn))))) + (lambda () + (package-substitute-availability + (package-substitute-availability-url + branch-commit))) + #:unwind? #t)) + + ;; TODO: Only include systems for which derivations are changed by + ;; this branch + (master-branch-systems-with-low-substitute-availability + (get-systems-with-low-substitute-availability + (master-branch-data) + (lset-difference + string=? + %systems-to-submit-builds-for + %systems-with-expected-low-substitute-availability)))) + + (values + revisions + derivation-changes-counts + substitute-availability + up-to-date-with-master? + master-branch-systems-with-low-substitute-availability)) + + (values #f #f #f #f #f))) (define* (master-branch-data) (let* ((substitute-availability |