Change branch comparisons to work on more specific commit ranges

Rather than just comparing against the latest master revision.

This includes changes to improve request handling to the data service.

1 files changed, 104 insertions, 68 deletions

diff --git a/guix-qa-frontpage/view/branch.scm b/guix-qa-frontpage/view/branch.scm
index ab881cb..b6cc81f 100644
--- a/guix-qa-frontpage/view/branch.scm
+++ b/guix-qa-frontpage/view/branch.scm
@@ -9,22 +9,18 @@
 
             master-branch-view))
 
-(define (branch-view branch change-details derivation-changes-counts
+(define (branch-view branch revisions derivation-changes-counts
                      substitute-availability)
   (define* (package-derivations-comparison-link system
                                                 #:key build-change)
-    (let ((revisions
-           (assoc-ref change-details "revisions")))
-      (string-append
-       (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A&target=none"
-                      (assoc-ref (assoc-ref revisions "base")
-                                 "commit")
-                      (assoc-ref (assoc-ref revisions "target")
-                                 "commit")
-                      system)
-       (if build-change
-           (simple-format #f "&build_change=~A" build-change)
-           ""))))
+    (string-append
+     (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A&target=none"
+                    (assq-ref revisions 'base)
+                    (assq-ref revisions 'target)
+                    system)
+     (if build-change
+         (simple-format #f "&build_change=~A" build-change)
+         "")))
 
   (layout
    #:title (simple-format #f "Branch ~A" branch)
@@ -47,57 +43,59 @@ td.bad {
    `((main
       (h2 "Substitute availability")
       (div
-       ,@(map
-          (lambda (details)
-            `(table
-              (thead
-               (tr
-                (th (@ (colspan 3))
-                    ,(assoc-ref
-                      (assoc-ref details "server")
-                      "url"))))
-              (tbody
-               ,@(map
-                  (lambda (system-and-target-details)
-                    (let* ((ratio
-                            (/ (assoc-ref system-and-target-details
-                                          "known")
-                               (+ (assoc-ref system-and-target-details
-                                             "known")
-                                  (assoc-ref system-and-target-details
-                                             "unknown"))))
-                           (color
-                            (cond ((> ratio 0.80) "green")
-                                  ((< ratio 0.50) "red")
-                                  (else           "orange")))
-                           (symbol
-                            (cond ((> ratio 0.80)
-                                   '(*ENTITY* "#9788"))
-                                  ((< ratio 0.50)
-                                   '(*ENTITY* "#9729"))
-                                  (else
-                                   '(*ENTITY* "#9925")))))
-                      `(tr
-                        (td
-                         (@ (style "font-family: monospace;"))
-                         ,(assoc-ref system-and-target-details
-                                     "system"))
-                        (td
-                         ,(format #f "~,1f%" (* 100. ratio)))
-                        (td (@ (style ,(string-append
-                                        "color: black;"
-                                        (if color
-                                            (simple-format
-                                             #f "background-color: ~A;" color)
-                                            ""))))
-                            ,symbol))))
-                  (filter
-                   (lambda (details)
-                     (string-null?
-                      (assoc-ref details "target")))
-                   (vector->list
-                    (assoc-ref details "availability")))))))
-          (vector->list substitute-availability)))
+       ,@(if substitute-availability
+             (map
+              (lambda (details)
+                `(table
+                  (thead
+                   (tr
+                    (th (@ (colspan 3))
+                        ,(assoc-ref
+                          (assoc-ref details "server")
+                          "url"))))
+                  (tbody
+                   ,@(map
+                      (lambda (system-and-target-details)
+                        (let* ((ratio
+                                (/ (assoc-ref system-and-target-details
+                                              "known")
+                                   (+ (assoc-ref system-and-target-details
+                                                 "known")
+                                      (assoc-ref system-and-target-details
+                                                 "unknown"))))
+                               (color
+                                (cond ((> ratio 0.80) "green")
+                                      ((< ratio 0.50) "red")
+                                      (else           "orange")))
+                               (symbol
+                                (cond ((> ratio 0.80)
+                                       '(*ENTITY* "#9788"))
+                                      ((< ratio 0.50)
+                                       '(*ENTITY* "#9729"))
+                                      (else
+                                       '(*ENTITY* "#9925")))))
+                          `(tr
+                            (td
+                             (@ (style "font-family: monospace;"))
+                             ,(assoc-ref system-and-target-details
+                                         "system"))
+                            (td
+                             ,(format #f "~,1f%" (* 100. ratio)))
+                            (td (@ (style ,(string-append
+                                            "color: black;"
+                                            (if color
+                                                (simple-format
+                                                 #f "background-color: ~A;" color)
+                                                ""))))
+                                ,symbol))))
+                      (filter
+                       (lambda (details)
+                         (string-null?
+                          (assoc-ref details "target")))
+                       (vector->list
+                        (assoc-ref details "availability")))))))
+              (vector->list substitute-availability))
+             '("Information unavailable")))
 
       (h2 "Packages")
       (div
@@ -138,7 +136,8 @@ td.bad {
                     "Unknown")
                 (th)))))
         (tbody
-         ,@(if derivation-changes-counts
+         ,@(if (and derivation-changes-counts
+                    (not (assq-ref derivation-changes-counts 'exception)))
                (if (null? derivation-changes-counts)
                    `((tr
                       (td (@ (colspan 7))
@@ -183,9 +182,46 @@ td.bad {
                                     ,(package-derivations-comparison-link system)))
                                 "View comparison")))))
                     derivation-changes-counts))
-               '((tr
-                  (td (@ (colspan 7))
-                      "Comparison unavailable")))))))))))
+               `((tr
+                  (td (@ (colspan 10))
+                      "Comparison unavailable"
+                      ,@(or (and=>
+                             (assq-ref derivation-changes-counts
+                                       'invalid_query_parameters)
+                             (lambda (params)
+                               (append-map
+                                (match-lambda
+                                  ((param . error)
+                                   (cond
+                                    ((member param '("base_commit"
+                                                     "target_commit"))
+                                     `((br)
+                                       (a
+                                        (@ (href
+                                            ,(string-append
+                                             "https://data.qa.guix.gnu.org"
+                                             "/revision/"
+                                             (assq-ref
+                                              revisions
+                                              (if (string=? param "base_commit")
+                                                  'base
+                                                  'target)))))
+                                        ,(cond
+                                          ((member error
+                                                   '(yet-to-process-revision
+                                                     failed-to-process-revision))
+                                           (simple-format
+                                            #f "~A to process ~A"
+                                            (if (eq? error 'yet-to-process-revision)
+                                                "Yet"
+                                                "Failed")
+                                            (if (string=? param "base_commit")
+                                                "base revision (from master branch)"
+                                                (string-append
+                                                 "target revision (from "
+                                                 branch " branch)")))))))))))
+                                params)))
+                            '()))))))))))))
 
 (define (master-branch-view substitute-availability)
   (layout