aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--guix-qa-frontpage/issue.scm19
-rw-r--r--guix-qa-frontpage/server.scm21
-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
6 files changed, 159 insertions, 79 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 67a4c78..6ceb733 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -34,6 +34,7 @@
#:use-module (guix-qa-frontpage guix-data-service)
#:use-module (guix-qa-frontpage derivation-changes)
#:export (%overall-statuses
+ %systems-to-consider-in-issue-status
status-index
issue-patches-overall-status
@@ -45,6 +46,7 @@
(define good-status 'important-checks-passing)
(define bad-status 'important-checks-failing)
(define needs-looking-at-status 'needs-looking-at)
+(define waiting-for-build-results-status 'waiting-for-build-results)
(define unknown-status 'unknown)
(define large-number-of-builds-status 'large-number-of-builds)
(define failed-to-apply-patches-status 'failed-to-apply-patches)
@@ -55,6 +57,7 @@
(list reviewed-looks-good-status
good-status
large-number-of-builds-status
+ waiting-for-build-results-status
unknown-status
needs-looking-at-status
failed-to-apply-patches-status
@@ -71,6 +74,12 @@
(list-ref %overall-statuses
(apply max (map status-index statuses))))
+(define %systems-to-consider-in-issue-status
+ '("x86_64-linux"
+ "i686-linux"
+ "aarch64-linux"
+ "armhf-linux"))
+
(define (issue-patches-overall-status patches-failed-to-apply?
patches-missing?
builds-missing?
@@ -78,12 +87,6 @@
comparison-details
mumi-tags
debbugs-usertags)
- (define %systems-to-consider
- '("x86_64-linux"
- "i686-linux"
- "aarch64-linux"
- "armhf-linux"))
-
(define (guix-data-service-failed?)
(and=>
(assq-ref comparison-details 'exception)
@@ -144,11 +147,11 @@
new-failures)
needs-looking-at-status
bad-status))
- unknown-status)))))
+ waiting-for-build-results-status)))))
(filter
(lambda (builds-by-system)
(member (car builds-by-system)
- %systems-to-consider))
+ %systems-to-consider-in-issue-status))
derivation-changes-counts))))))
(define tags-status
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 9677aea..d0262a7 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -473,6 +473,27 @@
<text x=\"90\" y=\"22\" fill=\"#fff\">Investigate</text>
</g>
</svg>")
+ ((eq? overall-status 'waiting-for-build-results)
+ "
+<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"272\" height=\"36\">
+ <clipPath id=\"clip\">
+ <rect width=\"140\" height=\"36\" rx=\"4\"/>
+ </clipPath>
+ <linearGradient id=\"job\" x1=\"0\" x2=\"0\" y1=\"0\" y2=\"1\">
+ <stop offset=\"0\" stop-color=\"#666\" />
+ <stop offset=\"1\" stop-color=\"#333\" />
+ </linearGradient>
+ <linearGradient id=\"status\" x1=\"0\" x2=\"0\" y1=\"0\" y2=\"1\">
+ <stop offset=\"0\" stop-color=\"lightblue\" />
+ <stop offset=\"1\" stop-color=\"lightblue\" />
+ </linearGradient>
+ <g clip-path=\"url(#clip)\" font-family=\"DejaVu Sans,Verdana,sans-serif\" font-size=\"14\" text-anchor=\"middle\">
+ <rect width=\"40\" height=\"36\" fill=\"url(#job)\"/>
+ <text x=\"20\" y=\"22\" fill=\"#fff\">QA</text>
+ <rect x=\"40\" width=\"100\" height=\"36\" fill=\"url(#status)\"/>
+ <text x=\"90\" y=\"22\" fill=\"#000\">Investigate</text>
+ </g>
+</svg>")
((eq? overall-status 'guix-data-service-failed)
"
<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"272\" height=\"36\">
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-05-18 16:34:43 +0000