diff options
-rw-r--r-- | guix-qa-frontpage/issue.scm | 19 | ||||
-rw-r--r-- | guix-qa-frontpage/server.scm | 21 | ||||
-rw-r--r-- | guix-qa-frontpage/view/issue.scm | 11 | ||||
-rw-r--r-- | guix-qa-frontpage/view/patches.scm | 8 | ||||
-rw-r--r-- | guix-qa-frontpage/view/shared.scm | 169 | ||||
-rw-r--r-- | guix-qa-frontpage/view/util.scm | 10 |
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; |