aboutsummaryrefslogtreecommitdiff
path: root/guix-qa-frontpage/view
diff options
context:
space:
mode:
Diffstat (limited to 'guix-qa-frontpage/view')
-rw-r--r--guix-qa-frontpage/view/issue.scm11
-rw-r--r--guix-qa-frontpage/view/patches.scm8
-rw-r--r--guix-qa-frontpage/view/shared.scm169
-rw-r--r--guix-qa-frontpage/view/util.scm10
4 files changed, 127 insertions, 71 deletions
diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index bbd34e2..4e851f8 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -6,6 +6,7 @@
#:use-module (guix-qa-frontpage issue)
#:use-module (guix-qa-frontpage manage-builds)
#:use-module (guix-qa-frontpage guix-data-service)
+ #:use-module (guix-qa-frontpage issue)
#:use-module (guix-qa-frontpage derivation-changes)
#:use-module (guix-qa-frontpage view util)
#:use-module (guix-qa-frontpage view shared)
@@ -230,7 +231,8 @@
(target . ,(assoc-ref (assoc-ref revisions "target")
"commit"))))
derivation-changes-counts
- (string-append "/issue/" issue-number))
+ (string-append "/issue/" issue-number)
+ %systems-to-consider-in-issue-status)
(h4 "Cross builds from "
(code "x86_64-linux"))
@@ -314,6 +316,13 @@ td.bad {
border: 0.3rem dashed red;
}
+td.pending {
+ padding: 0.05rem 0.65rem;
+ font-weight: bold;
+
+ border: 0.2rem dashed blue;
+}
+
div.bad {
padding: 0.05rem 0.65rem;
border: 0.3rem dashed red;
diff --git a/guix-qa-frontpage/view/patches.scm b/guix-qa-frontpage/view/patches.scm
index 5eecbd0..3fffa3b 100644
--- a/guix-qa-frontpage/view/patches.scm
+++ b/guix-qa-frontpage/view/patches.scm
@@ -35,6 +35,10 @@
'(span (@ (aria-label "status: purple")
(class "purple-dot"))
(*ENTITY* "#10005")))
+ ((eq? status 'waiting-for-build-results)
+ '(span (@ (aria-label "status: lightblue")
+ (class "lightblue-dot"))
+ "?"))
((eq? status 'patches-missing)
'(span (@ (aria-label "status: pink")
(class "pink-dot"))
@@ -144,6 +148,10 @@ will appear first.")
`((span (@ (aria-label "status: purple")
(class "purple-dot"))
(*ENTITY* "#10005"))))
+ ((eq? status 'waiting-for-build-results)
+ `((span (@ (aria-label "status: lightblue")
+ (class "lightblue-dot"))
+ "?")))
((eq? status 'patches-missing)
`((span (@ (aria-label "status: pink")
(class "pink-dot"))
diff --git a/guix-qa-frontpage/view/shared.scm b/guix-qa-frontpage/view/shared.scm
index e1f26ab..3112028 100644
--- a/guix-qa-frontpage/view/shared.scm
+++ b/guix-qa-frontpage/view/shared.scm
@@ -578,7 +578,8 @@
(define (package-changes-summary-table revisions
derivation-changes-counts
- package-changes-url-prefix)
+ package-changes-url-prefix
+ systems-affecting-status)
(define* (package-derivations-comparison-link system
#:key build-change)
@@ -598,6 +599,76 @@
(simple-format #f "&build_change=~A" build-change)
"")))
+ (define* (system+derivations->tr system derivations
+ #:key bad-highlighting)
+ (define (count side status)
+ (assoc-ref (assoc-ref
+ derivations
+ side)
+ status))
+ `(tr
+ (td (@ (class "monospace")) ,system)
+ ,@(map (lambda (status)
+ `(td ,(count 'base status)))
+ '(succeeding failing blocked unknown))
+ (td ,@(if (and (>= (count 'target 'succeeding)
+ (count 'base 'succeeding))
+ (> (count 'target 'succeeding)
+ 0))
+ `((@ (class "good")))
+ '())
+ (a (@ (href
+ ,(string-append
+ package-changes-url-prefix
+ "/package-changes?"
+ system "-change=fixed&"
+ system "-change=still-working&"
+ system "-change=unknown-to-working&"
+ system "-change=new-working")))
+ ,(count 'target 'succeeding)))
+ (td ,@(if (and bad-highlighting
+ (> (count 'target 'failing)
+ (count 'base 'failing)))
+ '((@ (class "bad")))
+ '())
+ (a (@ (href
+ ,(string-append
+ package-changes-url-prefix
+ "/package-changes?"
+ system "-change=broken&"
+ system "-change=still-failing&"
+ system "-change=unknown-to-failing&"
+ system "-change=new-failing")))
+ ,(count 'target 'failing)))
+ (td ,@(if (and bad-highlighting
+ (> (count 'target 'blocked)
+ (count 'base 'blocked)))
+ '((@ (class "bad")))
+ '())
+ (a (@ (href
+ ,(string-append
+ package-changes-url-prefix
+ "/package-changes?"
+ system "-change=blocked&"
+ system "-change=still-blocked&"
+ system "-change=unknown-to-blocked&"
+ system "-change=new-blocked")))
+ ,(count 'target 'blocked)))
+ (td (@ ,@(if (and bad-highlighting
+ (> (count 'target 'unknown)
+ (count 'base 'unknown)))
+ '((class "pending"))
+ '()))
+ (a (@ (href
+ ,(string-append
+ package-changes-url-prefix
+ "/package-changes?"
+ system "-change=unknown")))
+ ,(count 'target 'unknown)))
+ (td (a (@ (href
+ ,(package-derivations-comparison-link system)))
+ "View comparison"))))
+
`(table
(@ (style "border-collapse: collapse;"))
(thead
@@ -641,75 +712,33 @@
`((tr
(td (@ (colspan 7))
"No package derivation changes")))
- (map
- (match-lambda
- ((system . derivations)
-
- (define (count side status)
- (assoc-ref (assoc-ref
- derivations
- side)
- status))
- `(tr
- (td (@ (class "monospace")) ,system)
- ,@(map (lambda (status)
- `(td ,(count 'base status)))
- '(succeeding failing blocked unknown))
- (td ,@(if (and (>= (count 'target 'succeeding)
- (count 'base 'succeeding))
- (> (count 'target 'succeeding)
- 0))
- `((@ (class "good")))
- '())
- (a (@ (href
- ,(string-append
- package-changes-url-prefix
- "/package-changes?"
- system "-change=fixed&"
- system "-change=still-working&"
- system "-change=unknown-to-working&"
- system "-change=new-working")))
- ,(count 'target 'succeeding)))
- (td ,@(if (> (count 'target 'failing)
- (count 'base 'failing))
- '((@ (class "bad")))
- '())
- (a (@ (href
- ,(string-append
- package-changes-url-prefix
- "/package-changes?"
- system "-change=broken&"
- system "-change=still-failing&"
- system "-change=unknown-to-failing&"
- system "-change=new-failing")))
- ,(count 'target 'failing)))
- (td ,@(if (> (count 'target 'blocked)
- (count 'base 'blocked))
- '((@ (class "bad")))
- '())
- (a (@ (href
- ,(string-append
- package-changes-url-prefix
- "/package-changes?"
- system "-change=blocked&"
- system "-change=still-blocked&"
- system "-change=unknown-to-blocked&"
- system "-change=new-blocked")))
- ,(count 'target 'blocked)))
- (td (@ ,@(if (> (count 'target 'unknown)
- (count 'base 'unknown))
- '((class "bad"))
- '()))
- (a (@ (href
- ,(string-append
- package-changes-url-prefix
- "/package-changes?"
- system "-change=unknown")))
- ,(count 'target 'unknown)))
- (td (a (@ (href
- ,(package-derivations-comparison-link system)))
- "View comparison")))))
- derivation-changes-counts))
+ (match (fold
+ (lambda (system result)
+ (if (member system systems-affecting-status)
+ (cons `(,@(car result) ,system)
+ (cdr result))
+ (cons (car result)
+ `(,@(cdr result) ,system))))
+ (cons '() '())
+ (map car derivation-changes-counts))
+ ((important-systems . other-systems)
+ (list
+ (append
+ (map
+ (lambda (system)
+ (system+derivations->tr
+ system
+ (assoc-ref derivation-changes-counts system)
+ #:bad-highlighting #t))
+ important-systems)
+ `((tr (td (@ (colspan 10))
+ "Build status for the below systems doesn't affect issue status")))
+ (map
+ (lambda (system)
+ (system+derivations->tr
+ system
+ (assoc-ref derivation-changes-counts system)))
+ other-systems))))))
`((tr
(td (@ (colspan 10)
(class "bad"))
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index b595b6b..60ec66a 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -186,6 +186,16 @@ main > header {
text-align: center;
}
+.lightblue-dot {
+ vertical-align: text-bottom;
+ height: 23px;
+ width: 23px;
+ background-color: lightblue;
+ border-radius: 50%;
+ display: inline-block;
+ text-align: center;
+}
+
.red-dot {
vertical-align: text-bottom;
height: 23px;
generated by cgit v1.2.3 (git 2.25.4) at 2024-06-02 01:47:10 +0000