Split out blocked builds from unknown builds

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