diff options
Diffstat (limited to 'guix-qa-frontpage/view/branch.scm')
| -rw-r--r-- | guix-qa-frontpage/view/branch.scm | 172 |
1 files changed, 104 insertions, 68 deletions
diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm index ab881cb..b6cc81f 100644 --- a/guix-qa-frontpage/view/branch.scm +++ b/guix-qa-frontpage/view/branch.scm @@ -9,22 +9,18 @@ master-branch-view)) -(define (branch-view branch change-details derivation-changes-counts +(define (branch-view branch revisions derivation-changes-counts substitute-availability) (define* (package-derivations-comparison-link system #:key build-change) - (let ((revisions - (assoc-ref change-details "revisions"))) - (string-append - (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A&target=none" - (assoc-ref (assoc-ref revisions "base") - "commit") - (assoc-ref (assoc-ref revisions "target") - "commit") - system) - (if build-change - (simple-format #f "&build_change=~A" build-change) - "")))) + (string-append + (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A&target=none" + (assq-ref revisions 'base) + (assq-ref revisions 'target) + system) + (if build-change + (simple-format #f "&build_change=~A" build-change) + ""))) (layout #:title (simple-format #f "Branch ~A" branch) @@ -47,57 +43,59 @@ td.bad { `((main (h2 "Substitute availability") (div - ,@(map - (lambda (details) - `(table - (thead - (tr - (th (@ (colspan 3)) - ,(assoc-ref - (assoc-ref details "server") - "url")))) - (tbody - ,@(map - (lambda (system-and-target-details) - (let* ((ratio - (/ (assoc-ref system-and-target-details - "known") - (+ (assoc-ref system-and-target-details - "known") - (assoc-ref system-and-target-details - "unknown")))) - (color - (cond ((> ratio 0.80) "green") - ((< ratio 0.50) "red") - (else "orange"))) - (symbol - (cond ((> ratio 0.80) - '(*ENTITY* "#9788")) - ((< ratio 0.50) - '(*ENTITY* "#9729")) - (else - '(*ENTITY* "#9925"))))) - `(tr - (td - (@ (style "font-family: monospace;")) - ,(assoc-ref system-and-target-details - "system")) - (td - ,(format #f "~,1f%" (* 100. ratio))) - (td (@ (style ,(string-append - "color: black;" - (if color - (simple-format - #f "background-color: ~A;" color) - "")))) - ,symbol)))) - (filter - (lambda (details) - (string-null? - (assoc-ref details "target"))) - (vector->list - (assoc-ref details "availability"))))))) - (vector->list substitute-availability))) + ,@(if substitute-availability + (map + (lambda (details) + `(table + (thead + (tr + (th (@ (colspan 3)) + ,(assoc-ref + (assoc-ref details "server") + "url")))) + (tbody + ,@(map + (lambda (system-and-target-details) + (let* ((ratio + (/ (assoc-ref system-and-target-details + "known") + (+ (assoc-ref system-and-target-details + "known") + (assoc-ref system-and-target-details + "unknown")))) + (color + (cond ((> ratio 0.80) "green") + ((< ratio 0.50) "red") + (else "orange"))) + (symbol + (cond ((> ratio 0.80) + '(*ENTITY* "#9788")) + ((< ratio 0.50) + '(*ENTITY* "#9729")) + (else + '(*ENTITY* "#9925"))))) + `(tr + (td + (@ (style "font-family: monospace;")) + ,(assoc-ref system-and-target-details + "system")) + (td + ,(format #f "~,1f%" (* 100. ratio))) + (td (@ (style ,(string-append + "color: black;" + (if color + (simple-format + #f "background-color: ~A;" color) + "")))) + ,symbol)))) + (filter + (lambda (details) + (string-null? + (assoc-ref details "target"))) + (vector->list + (assoc-ref details "availability"))))))) + (vector->list substitute-availability)) + '("Information unavailable"))) (h2 "Packages") (div @@ -138,7 +136,8 @@ td.bad { "Unknown") (th))))) (tbody - ,@(if derivation-changes-counts + ,@(if (and derivation-changes-counts + (not (assq-ref derivation-changes-counts 'exception))) (if (null? derivation-changes-counts) `((tr (td (@ (colspan 7)) @@ -183,9 +182,46 @@ td.bad { ,(package-derivations-comparison-link system))) "View comparison"))))) derivation-changes-counts)) - '((tr - (td (@ (colspan 7)) - "Comparison unavailable"))))))))))) + `((tr + (td (@ (colspan 10)) + "Comparison unavailable" + ,@(or (and=> + (assq-ref derivation-changes-counts + 'invalid_query_parameters) + (lambda (params) + (append-map + (match-lambda + ((param . error) + (cond + ((member param '("base_commit" + "target_commit")) + `((br) + (a + (@ (href + ,(string-append + "https://data.qa.guix.gnu.org" + "/revision/" + (assq-ref + revisions + (if (string=? param "base_commit") + 'base + 'target))))) + ,(cond + ((member error + '(yet-to-process-revision + failed-to-process-revision)) + (simple-format + #f "~A to process ~A" + (if (eq? error 'yet-to-process-revision) + "Yet" + "Failed") + (if (string=? param "base_commit") + "base revision (from master branch)" + (string-append + "target revision (from " + branch " branch)"))))))))))) + params))) + '())))))))))))) (define (master-branch-view substitute-availability) (layout |