From e7925610d59b32c6893de0a1a0b418aebb62a000 Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Tue, 15 Nov 2022 21:24:28 +0000 Subject: Split out blocked builds from unknown builds --- guix-qa-frontpage/derivation-changes.scm | 11 +++++++- guix-qa-frontpage/issue.scm | 2 ++ guix-qa-frontpage/view/issue.scm | 47 ++++++++++++++++++++------------ 3 files changed, 41 insertions(+), 19 deletions(-) diff --git a/guix-qa-frontpage/derivation-changes.scm b/guix-qa-frontpage/derivation-changes.scm index ecfb781..f339dce 100644 --- a/guix-qa-frontpage/derivation-changes.scm +++ b/guix-qa-frontpage/derivation-changes.scm @@ -86,8 +86,14 @@ (match-lambda* (((package . builds) result) (let* ((build-statuses + ;; Invent a new status here "blocked" (map (lambda (build) - (assoc-ref build "status")) + (let ((status + (assoc-ref build "status"))) + (if (and (string=? status "scheduled") + (assoc-ref build "potentially_blocked")) + "blocked" + status))) builds)) (category (cond @@ -96,6 +102,8 @@ ((and (not (member "suceeded" build-statuses)) (member "failed" build-statuses)) 'failing) + ((member "blocked" build-statuses) + 'blocked) (else 'unknown)))) @@ -105,6 +113,7 @@ ,@(alist-delete category result))))) '((succeeding . ()) (failing . ()) + (blocked . ()) (unknown . ())) builds-by-package))))) diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm index 3b5d8dd..a17093c 100644 --- a/guix-qa-frontpage/issue.scm +++ b/guix-qa-frontpage/issue.scm @@ -84,6 +84,8 @@ (count 'base 'succeeding)) (<= (count 'target 'failing) (count 'base 'failing)) + (<= (count 'target 'blocked) + (count 'base 'blocked)) (<= (count 'target 'unknown) (count 'base 'unknown))) good-status diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm index c3cf3ac..ce241dd 100644 --- a/guix-qa-frontpage/view/issue.scm +++ b/guix-qa-frontpage/view/issue.scm @@ -176,26 +176,32 @@ td.bad { (thead (tr (th (@ (rowspan 3)) "System") - (th (@ (colspan 6)) "Package build status") + (th (@ (colspan 8)) "Package build status") (th)) (tr - (th (@ (colspan 3)) "Base") - (th (@ (colspan 3)) "With patches applied") + (th (@ (colspan 4)) "Base") + (th (@ (colspan 4)) "With patches applied") (th)) (tr - (th (@ (style "min-width: 5rem;")) - "Succeeding") - (th (@ (style "min-width: 5rem;")) - "Failing") - (th (@ (style "min-width: 5rem;")) - "Unknown") - (th (@ (style "min-width: 5rem;")) - "Succeeding") - (th (@ (style "min-width: 5rem;")) - "Failing") - (th (@ (style "min-width: 5rem;")) - "Unknown") - (th))) + ,@(let ((header-style + "font-size: 80%; min-width: 3.5rem;")) + `((th (@ (style ,header-style)) + "Succeeding") + (th (@ (style ,header-style)) + "Failing") + (th (@ (style ,header-style)) + "Blocked") + (th (@ (style ,header-style)) + "Unknown") + (th (@ (style ,header-style)) + "Succeeding") + (th (@ (style ,header-style)) + "Failing") + (th (@ (style ,header-style)) + "Blocked") + (th (@ (style ,header-style)) + "Unknown") + (th))))) (tbody ,@(if (and comparison-details derivation-changes) @@ -251,7 +257,7 @@ td.bad { (td (@ (class "monospace")) ,system) ,@(map (lambda (status) `(td ,(count 'base status))) - '(succeeding failing unknown)) + '(succeeding failing blocked unknown)) (td ,@(if (and (>= (count 'target 'succeeding) (count 'base 'succeeding)) (> (count 'target 'succeeding) @@ -267,6 +273,11 @@ td.bad { #:build-change "broken"))) ,(count 'target 'failing))) `(td ,(count 'target 'failing))) + ,(if (> (count 'target 'blocked) + (count 'base 'blocked)) + `(td (@ (class "bad")) + ,(count 'target 'blocked)) + `(td ,(count 'target 'blocked))) ,(if (> (count 'target 'unknown) (count 'base 'unknown)) `(td (@ (class "bad")) @@ -292,7 +303,7 @@ td.bad { %systems-to-submit-builds-for) 10))))))) '((tr - (td (@ (colspan 7)) + (td (@ (colspan 10)) "Comparison unavailable"))))))) (div -- cgit v1.2.3