From aafd4643bf7231e5df703e6ea167d7eccbc2556f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 11 Mar 2023 11:58:07 +0000
Subject: Better manage the data for issues

Don't use the full derivation changes data when trying to render the page, as
that might be quite large. Instead, compute and cache the counts, and then use
this for rendering.
---
 guix-qa-frontpage/issue.scm | 96 +++++++++++++++++----------------------------
 1 file changed, 37 insertions(+), 59 deletions(-)

(limited to 'guix-qa-frontpage/issue.scm')

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)
-- 
cgit v1.2.3