Try to start highlighting patch issues which pass some checks

5 files changed, 122 insertions, 11 deletions

diff --git a/Makefile.am b/Makefile.am
index f17c5e1..5ab92c9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -32,6 +32,7 @@ SOURCES =									\
   guix-qa-frontpage/database.scm						\
   guix-qa-frontpage/patchwork.scm						\
   guix-qa-frontpage/guix-data-service.scm					\
+  guix-qa-frontpage/issue.scm							\
   guix-qa-frontpage/derivation-changes.scm					\
   guix-qa-frontpage/manage-builds.scm						\
   guix-qa-frontpage/view/util.scm						\
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
new file mode 100644
index 0000000..ee3e210
--- /dev/null
+++ b/guix-qa-frontpage/issue.scm
@@ -0,0 +1,72 @@
+;;; Guix QA Frontpage
+;;;
+;;; Copyright © 2022 Christopher Baines <mail@cbaines.net>
+;;;
+;;; This program is free software: you can redistribute it and/or
+;;; modify it under the terms of the GNU Affero General Public License
+;;; as published by the Free Software Foundation, either version 3 of
+;;; the License, or (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Affero General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Affero General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (guix-qa-frontpage issue)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
+  #:use-module (guix-qa-frontpage derivation-changes)
+  #:export (issue-patches-overall-status))
+
+(define (issue-patches-overall-status derivation-changes)
+  (define good-status
+    'important-checks-passing)
+
+  (let* ((base-builds
+          (builds-by-system-excluding-cross-builds
+           derivation-changes "base"))
+         (target-builds
+          (builds-by-system-excluding-cross-builds
+           derivation-changes "target"))
+
+         (all-systems
+          (delete-duplicates
+           (append (map car base-builds)
+                   (map car target-builds))))
+
+         (categorised-base-builds-by-system
+          (categorise-builds all-systems base-builds))
+         (categorised-target-builds-by-system
+          (categorise-builds all-systems target-builds)))
+
+    (if (null? target-builds)
+        good-status
+        (every
+         (match-lambda
+           ((system . categorised-target-builds)
+            (let ((categorised-base-builds
+                   (assoc-ref categorised-base-builds-by-system
+                              system)))
+              (define (count side status)
+                (length
+                 (assoc-ref
+                  (if (eq? side 'base)
+                      categorised-base-builds
+                      categorised-target-builds)
+                  status)))
+
+              (if (and (>= (count 'target 'succeeding)
+                           (count 'base 'succeeding))
+                       (> (count 'target 'succeeding)
+                          0)
+                       (<= (count 'target 'failing)
+                           (count 'base 'failing))
+                       (<= (count 'target 'unknown)
+                           (count 'base 'unknown)))
+                  good-status
+                  #f))))
+         categorised-target-builds-by-system))))
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index aeae8fb..1f85f99 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -33,6 +33,7 @@
   #:use-module ((guix-build-coordinator utils) #:select (get-gc-metrics-updater))
   #:use-module (guix-qa-frontpage database)
   #:use-module (guix-qa-frontpage patchwork)
+  #: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 view util)
@@ -111,15 +112,36 @@
           (branch-view branch
                        derivation-changes))))
       (('GET "patches")
-       (let ((latest-series
-              (with-sqlite-cache
-               database
-               'latest-patchwork-series-by-issue
-               latest-patchwork-series-by-issue
-               #:ttl 1200)))
+       (let* ((latest-series
+               (with-sqlite-cache
+                database
+                'latest-patchwork-series-by-issue
+                latest-patchwork-series-by-issue
+                #:ttl 1200))
+              (statuses
+               (map
+                (lambda (series index)
+                  (if (> index 50)
+                      #f
+                      (let ((derivation-changes
+                             (and=> (patch-series-derivation-changes-url
+                                     series
+                                     #:systems %systems-to-submit-builds-for)
+                                    (lambda (url)
+                                      (with-sqlite-cache
+                                       database
+                                       'derivation-changes
+                                       patch-series-derivation-changes
+                                       #:args (list url)
+                                       #:ttl 6000)))))
+                        (and derivation-changes
+                             (issue-patches-overall-status derivation-changes)))))
+                latest-series
+                (iota (length latest-series)))))
          (render-html
           #:sxml
-          (patches-view latest-series))))
+          (patches-view latest-series
+                        statuses))))
       (('GET "issue" number)
        (let ((series (assq-ref (with-sqlite-cache
                                 database
diff --git a/guix-qa-frontpage/view/patches.scm b/guix-qa-frontpage/view/patches.scm
index d6cb456..672eb81 100644
--- a/guix-qa-frontpage/view/patches.scm
+++ b/guix-qa-frontpage/view/patches.scm
@@ -4,18 +4,25 @@
   #:use-module (guix-qa-frontpage view util)
   #:export (patches-view))
 
-(define (patches-view latest-series)
+(define (patches-view latest-series statuses)
   (layout
    #:title "Patches"
    #:body
    `((main
       (table
        (tbody
-        ,@(map (match-lambda
-                 ((id . details)
+        ,@(map (match-lambda*
+                 (((id . details) status)
                   `(tr
                     (td (a (@ (href ,(simple-format #f "/issue/~A" id)))
                            ,id))
+                    (td
+                     (@ (style "vertical-align: middle;"))
+                     ,@(if (eq? status 'important-checks-passing)
+                           `((span (@ (aria-label "status: green")
+                                      (class "green-dot"))))
+                           '()))
                     (td (@ (style "text-align: left;"))
                         ,(assoc-ref details "name")))))
-               latest-series)))))))
+               latest-series
+               statuses)))))))
diff --git a/guix-qa-frontpage/view/util.scm b/guix-qa-frontpage/view/util.scm
index 1317ee8..ce2ddb9 100644
--- a/guix-qa-frontpage/view/util.scm
+++ b/guix-qa-frontpage/view/util.scm
@@ -136,6 +136,15 @@ header {
   }
 }
 
+.green-dot {
+  vertical-align: text-bottom;
+  height: 23px;
+  width: 23px;
+  background-color: #28a745;
+  border-radius: 50%;
+  display: inline-block;
+}
+
 ")
       ,@head)
      (body (header