Start to better describe when builds are waiting to happen

Don't use the same styling as failed builds on the issue page, and also
separate out the systems which don't count towards the issue status.

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;