1 files changed, 80 insertions, 44 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index ee3e210..14eb34b 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -20,53 +20,89 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (guix-qa-frontpage derivation-changes)
-  #:export (issue-patches-overall-status))
+  #:export (%overall-statuses
+            status-index
 
-(define (issue-patches-overall-status derivation-changes)
-  (define good-status
-    'important-checks-passing)
+            issue-patches-overall-status))
 
-  (let* ((base-builds
-          (builds-by-system-excluding-cross-builds
-           derivation-changes "base"))
-         (target-builds
-          (builds-by-system-excluding-cross-builds
-           derivation-changes "target"))
+(define good-status 'important-checks-passing)
+(define bad-status 'important-checks-failing)
+(define needs-looking-at-status 'needs-looking-at)
+(define unknown-status 'unknown)
 
-         (all-systems
-          (delete-duplicates
-           (append (map car base-builds)
-                   (map car target-builds))))
+(define %overall-statuses
+  (list good-status
+        needs-looking-at-status
+        bad-status
+        unknown-status))
 
-         (categorised-base-builds-by-system
-          (categorise-builds all-systems base-builds))
-         (categorised-target-builds-by-system
-          (categorise-builds all-systems target-builds)))
+(define (status-index status)
+  (list-index (lambda (s)
+                (eq? s status))
+              %overall-statuses))
 
-    (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)))
+(define (issue-patches-overall-status derivation-changes mumi-tags)
+  (define builds-status
+    (let* ((base-builds
+            (builds-by-system-excluding-cross-builds
+             derivation-changes "base"))
+           (target-builds
+            (builds-by-system-excluding-cross-builds
+             derivation-changes "target"))
 
-              (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))))
+           (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
+          (or
+           (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)
+           unknown-status))))
+
+  (define tags-status
+    (if (member "moreinfo" mumi-tags)
+        needs-looking-at-status
+        good-status))
+
+  (let ((lowest-status
+         (list-ref
+          %overall-statuses
+          (apply min
+                 (map (lambda (status)
+                        (list-index (lambda (x)
+                                      (eq? x status))
+                                    %overall-statuses))
+                      (list builds-status
+                            tags-status))))))
+    lowest-status))