1 files changed, 37 insertions, 59 deletions
diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 1c5f52d..587a070 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -46,7 +46,7 @@
   (list-ref %overall-statuses
             (apply max (map status-index statuses))))
 
-(define (issue-patches-overall-status derivation-changes mumi-tags)
+(define (issue-patches-overall-status derivation-changes-counts builds-missing? mumi-tags)
   (define %systems-to-consider
     '("x86_64-linux"
       ;; "i686-linux" disabled while resolving bordeaux build issues
@@ -54,65 +54,43 @@
       "armhf-linux"))
 
   (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"))
-
-           (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 (builds-missing-for-derivation-changes? derivation-changes)
-          unknown-status
-          (if (null? target-builds)
-              good-status
-              (worst-status
-               (map
-                (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 builds-missing?
+        unknown-status
+        (if (null? derivation-changes-counts)
+            good-status
+            (worst-status
+             (map
+              (match-lambda
+                ((system . counts)
+                 (define (count side status)
+                   (assoc-ref (assoc-ref
+                               counts
+                               side)
+                              status))
 
-                     (let ((base-failure-count (count 'base 'failing))
-                           (target-failure-count (count 'target 'failing)))
-                       (if (and (<= target-failure-count
-                                    base-failure-count)
-                                (= (count 'target 'unknown) 0))
-                           good-status
-                           (if (= (count 'target 'unknown) 0)
-                               (let ((unblocked-builds
-                                      (- (count 'base 'blocked)
-                                         (count 'target 'blocked)))
-                                     (new-failures
-                                      (- target-failure-count
-                                         base-failure-count)))
-                                 (if (>= unblocked-builds
-                                         new-failures)
-                                     needs-looking-at-status
-                                     bad-status))
-                               unknown-status))))))
-                (filter
-                 (lambda (builds-by-system)
-                   (member (car builds-by-system)
-                           %systems-to-consider))
-                 categorised-target-builds-by-system)))))))
+                 (let ((base-failure-count (count 'base 'failing))
+                       (target-failure-count (count 'target 'failing)))
+                   (if (and (<= target-failure-count
+                                base-failure-count)
+                            (= (count 'target 'unknown) 0))
+                       good-status
+                       (if (= (count 'target 'unknown) 0)
+                           (let ((unblocked-builds
+                                  (- (count 'base 'blocked)
+                                     (count 'target 'blocked)))
+                                 (new-failures
+                                  (- target-failure-count
+                                     base-failure-count)))
+                             (if (>= unblocked-builds
+                                     new-failures)
+                                 needs-looking-at-status
+                                 bad-status))
+                           unknown-status)))))
+              (filter
+               (lambda (builds-by-system)
+                 (member (car builds-by-system)
+                         %systems-to-consider))
+               derivation-changes-counts))))))
 
   (define tags-status
     (if (member "moreinfo" mumi-tags)