diff options
Diffstat (limited to 'guix-qa-frontpage/server.scm')
| -rw-r--r-- | guix-qa-frontpage/server.scm | 228 |
1 files changed, 119 insertions, 109 deletions
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm index f770574..219f3f1 100644 --- a/guix-qa-frontpage/server.scm +++ b/guix-qa-frontpage/server.scm @@ -317,62 +317,17 @@ (string->number number)))) (if series (let* ((base-and-target-refs + derivation-changes-counts + change-details + builds-missing? + comparison-details (with-sqlite-cache database - 'issue-branch-base-and-target-refs - get-issue-branch-base-and-target-refs - #:args (list (string->number number)) - #:ttl 1200 - #:store-computed-value? list?)) - (derivation-changes-data - change-details - (call-with-values - (lambda () - (and - base-and-target-refs - (with-exception-handler - (lambda (exn) - (simple-format - (current-error-port) - "exception fetching derivation changes: ~A\n" - exn) - - (values #f #f)) - (lambda () - (with-sqlite-cache - database - 'derivation-changes - derivation-changes - #:args - (list - (patch-series-derivation-changes-url - base-and-target-refs - #:systems %systems-to-submit-builds-for)) - #:ttl 6000)) - #:unwind? #t))) - (lambda res - (match res - ((#f) - (values #f #f)) - (_ (apply values res)))))) - (comparison-details - (and - base-and-target-refs - (with-exception-handler - (lambda (exn) - (if (guix-data-service-error? exn) - exn - (raise-exception exn))) - (lambda () - (with-sqlite-cache - database - 'lint-warnings - patch-series-comparison - #:args - (list (patch-series-compare-url - base-and-target-refs)) - #:ttl 6000)) - #:unwind? #t)))) + 'issue-data + issue-data + #:args + (list (string->number number)) + #:ttl 6000))) (render-html #:sxml (issue-view number series @@ -382,7 +337,8 @@ (patch-series-compare-url base-and-target-refs #:json? #f)) - derivation-changes-data + derivation-changes-counts + builds-missing? change-details comparison-details))) (render-html @@ -445,6 +401,67 @@ Check if it's already running, or whether another process is using that port. Also, the port used can be changed by passing the --port option.\n" port))))))) +(define (issue-data number) + (let* ((base-and-target-refs + (get-issue-branch-base-and-target-refs + number)) + (derivation-changes-data + change-details + (call-with-values + (lambda () + (and + base-and-target-refs + (with-exception-handler + (lambda (exn) + (simple-format + (current-error-port) + "exception fetching derivation changes: ~A\n" + exn) + + (values #f #f)) + (lambda () + (derivation-changes + (patch-series-derivation-changes-url + base-and-target-refs + #:systems %systems-to-submit-builds-for))) + #:unwind? #t))) + (lambda res + (match res + ((#f) + (values #f #f)) + (_ (apply values res)))))) + (derivation-changes-counts + (if derivation-changes-data + (derivation-changes-counts + derivation-changes-data + %systems-to-submit-builds-for) + #f)) + (builds-missing? + (if derivation-changes-data + (builds-missing-for-derivation-changes? + derivation-changes-data) + #t)) + (comparison-details + (and + base-and-target-refs + (with-exception-handler + (lambda (exn) + (if (guix-data-service-error? exn) + exn + (raise-exception exn))) + (lambda () + (patch-series-comparison + (patch-series-compare-url + base-and-target-refs))) + #:unwind? #t)))) + + (values + base-and-target-refs + derivation-changes-counts + change-details + builds-missing? + comparison-details))) + (define* (branch-data branch-name) (let* ((derivation-changes-data change-details @@ -489,60 +506,53 @@ port. Also, the port used can be changed by passing the --port option.\n" (n-par-for-each 4 (lambda (series) - (let ((derivation-changes-data - (with-exception-handler - (lambda (exn) - (unless - (and (guix-data-service-error? exn) - ;; This probably just means the target - ;; revision hasn't been processed yet. The - ;; Guix Data Service should send a more - ;; informative response though. - (and=> (assoc-ref - (guix-data-service-error-response-body exn) - "error") - (lambda (error) - (string=? error - "invalid query")))) - (simple-format - (current-error-port) - "failed fetching derivation changes for issue ~A: ~A\n" - (car series) - exn)) - - #f) - (lambda () - (and=> - (with-sqlite-cache - database - 'issue-branch-base-and-target-refs - get-issue-branch-base-and-target-refs - #:args (list (car series)) - #:ttl 0 - #:store-computed-value? list?) - (lambda (base-and-target-refs) - (with-sqlite-cache - database - 'derivation-changes - derivation-changes - #:args - (list (patch-series-derivation-changes-url - base-and-target-refs - #:systems %systems-to-submit-builds-for)) - #:ttl (/ frequency 2))))) - #:unwind? #t))) - - (and derivation-changes-data - (with-sqlite-cache - database - 'issue-patches-overall-status - (lambda (id) - (issue-patches-overall-status - derivation-changes-data - (assq-ref (assq-ref series 'mumi) - 'tags))) - #:args (list (car series)) - #:ttl 0)))) + (with-exception-handler + (lambda (exn) + (unless + (and (guix-data-service-error? exn) + ;; This probably just means the target + ;; revision hasn't been processed yet. The + ;; Guix Data Service should send a more + ;; informative response though. + (and=> (assoc-ref + (guix-data-service-error-response-body exn) + "error") + (lambda (error) + (string=? error + "invalid query")))) + (simple-format + (current-error-port) + "failed fetching derivation changes for issue ~A: ~A\n" + (car series) + exn)) + + #f) + (lambda () + (let ((base-and-target-refs + derivation-changes-counts + change-details + builds-missing? + comparison-details + (with-sqlite-cache + database + 'issue-data + issue-data + #:args + (list (car series)) + #:ttl 6000))) + + (with-sqlite-cache + database + 'issue-patches-overall-status + (lambda (id) + (issue-patches-overall-status + derivation-changes-counts + builds-missing? + (assq-ref (assq-ref series 'mumi) + 'tags))) + #:args (list (car series)) + #:ttl 0))) + #:unwind? #t)) series-to-refresh))) (call-with-new-thread |