Show the changes to cross derivations on issue pages

1 files changed, 70 insertions, 48 deletions

diff --git a/guix-qa-frontpage/issue.scm b/guix-qa-frontpage/issue.scm
index 345aafe..87d7a64 100644
--- a/guix-qa-frontpage/issue.scm
+++ b/guix-qa-frontpage/issue.scm
@@ -151,62 +151,82 @@
                             tags-status))))))
 
 (define (issue-data number)
+  (define (call-with-data-service-error-handling thunk)
+    (with-exception-handler
+        (lambda (exn)
+          (if (guix-data-service-error? exn)
+              `((exception . guix-data-service-invalid-parameters)
+                (invalid_query_parameters
+                 .
+                 ,(filter-map
+                   (match-lambda
+                     ((param . val)
+                      (and=>
+                       (assoc-ref val "invalid_value")
+                       (lambda (value)
+                         (let ((message
+                                (assoc-ref val "message")))
+                           (cons
+                            param
+                            `((value . ,value)
+                              (error
+                               ;; Convert the HTML error messages
+                               ;; to something easier to handle
+                               . ,(cond
+                                   ((string-contains message
+                                                     "failed to process revision")
+                                    'failed-to-process-revision)
+                                   ((string-contains message
+                                                     "yet to process revision")
+                                    'yet-to-process-revision)
+                                   (else
+                                    'unknown))))))))))
+                   (assoc-ref
+                    (guix-data-service-error-response-body exn)
+                    "query_parameters"))))
+              `((exception . ,(simple-format #f "~A" exn)))))
+      thunk
+      #:unwind? #t))
+
   (let* ((base-and-target-refs
           (get-issue-branch-base-and-target-refs
            number))
+         (derivation-changes-raw-data
+          (if base-and-target-refs
+              (call-with-data-service-error-handling
+               (lambda ()
+                 (compare-package-derivations
+                  (compare-package-derivations-url
+                   base-and-target-refs
+                   #:systems %systems-to-submit-builds-for))))
+              #f))
          (derivation-changes-data
+          (if (and derivation-changes-raw-data
+                   (not (assq-ref derivation-changes-raw-data 'exception)))
+              (derivation-changes
+               derivation-changes-raw-data
+               %systems-to-submit-builds-for)
+              #f))
+         (cross-derivation-changes-raw-data
           (if base-and-target-refs
-              (with-exception-handler
-                  (lambda (exn)
-                    (if (guix-data-service-error? exn)
-                        `((exception . guix-data-service-invalid-parameters)
-                          (invalid_query_parameters
-                           .
-                           ,(filter-map
-                             (match-lambda
-                               ((param . val)
-                                (and=>
-                                 (assoc-ref val "invalid_value")
-                                 (lambda (value)
-                                   (let ((message
-                                          (assoc-ref val "message")))
-                                     (cons
-                                      param
-                                      `((value . ,value)
-                                        (error
-                                         ;; Convert the HTML error messages
-                                         ;; to something easier to handle
-                                         . ,(cond
-                                             ((string-contains message
-                                                               "failed to process revision")
-                                              'failed-to-process-revision)
-                                             ((string-contains message
-                                                               "yet to process revision")
-                                              'yet-to-process-revision)
-                                             (else
-                                              'unknown))))))))))
-                             (assoc-ref
-                              (guix-data-service-error-response-body exn)
-                              "query_parameters"))))
-                        `((exception . ,(simple-format #f "~A" exn)))))
-                (lambda ()
-                  (compare-package-derivations
-                   (compare-package-derivations-url
-                    base-and-target-refs
-                    #:systems %systems-to-submit-builds-for)))
-                #:unwind? #t)
+              (call-with-data-service-error-handling
+               (lambda ()
+                 (compare-package-derivations
+                  (compare-package-cross-derivations-url
+                   base-and-target-refs
+                   #:systems %systems-to-submit-builds-for))))
               #f))
-         (derivation-changes
-          (if (and derivation-changes-data
-                   (not (assq-ref derivation-changes-data 'exception)))
+         (cross-derivation-changes-data
+          (if (and cross-derivation-changes-raw-data
+                   (not (assq-ref cross-derivation-changes-raw-data 'exception)))
               (derivation-changes
-               derivation-changes-data
+               cross-derivation-changes-raw-data
                %systems-to-submit-builds-for)
               #f))
          (builds-missing?
-          (if derivation-changes
+          (if derivation-changes-data
               (builds-missing-for-derivation-changes?
-               (assoc-ref derivation-changes-data
+               (assoc-ref derivation-changes-raw-data
                           "derivation_changes"))
               #t))
          (comparison-details
@@ -253,8 +273,9 @@
 
     (values
      base-and-target-refs
-     derivation-changes
-     (and=> derivation-changes-data
+     derivation-changes-data
+     cross-derivation-changes-data
+     (and=> derivation-changes-raw-data
             (lambda (changes)
               (alist-delete "derivation_changes" changes)))
      builds-missing?
@@ -300,6 +321,7 @@
             (lambda ()
               (let ((base-and-target-refs
                      derivation-changes
+                     cross-derivation-changes
                      change-details
                      builds-missing?
                      comparison-details
@@ -309,7 +331,7 @@
                       issue-data
                       #:args
                       (list issue-number)
-                      #:version 2
+                      #:version 3
                       #:ttl (/ frequency 2))))
 
                 (with-sqlite-cache