1 files changed, 95 insertions, 17 deletions

diff --git a/guix-qa-frontpage/view/issue.scm b/guix-qa-frontpage/view/issue.scm
index e3e380f..ad574e6 100644
--- a/guix-qa-frontpage/view/issue.scm
+++ b/guix-qa-frontpage/view/issue.scm
@@ -4,39 +4,117 @@
   #:use-module (guix-qa-frontpage view util)
   #:export (issue-view))
 
-(define (issue-view series derivation-changes)
-  (define builds-by-system-excluding-cross-builds
+(define (issue-view issue-number series derivation-changes
+                    change-details)
+  (define (builds-by-system-excluding-cross-builds side)
     (fold (lambda (package result)
             (fold
              (lambda (change result)
                (if (string=? (assoc-ref change "target")
                              "")
                    (let ((system (assoc-ref change "system")))
-                     `((,system . ,(+ 1
-                                      (or (assoc-ref result system)
-                                          0)))
+                     `((,system . ,(append
+                                    (vector->list (assoc-ref change "builds"))
+                                    (or (assoc-ref result system)
+                                        '())))
                        ,@(alist-delete system result)))
                    result))
              result
              (vector->list
-              (assoc-ref package "target"))))
+              (assoc-ref package side))))
           '()
           derivation-changes))
 
+  (define base-builds
+    (builds-by-system-excluding-cross-builds "base"))
+
+  (define target-builds
+    (builds-by-system-excluding-cross-builds "target"))
+
+  (define comparison-link
+    (let ((revisions
+           (assoc-ref change-details "revisions")))
+      (simple-format #f "https://data.qa.guix.gnu.org/compare?base_commit=~A&target_commit=~A"
+                     (assoc-ref (assoc-ref revisions "base")
+                                "commit")
+                     (assoc-ref (assoc-ref revisions "target")
+                                "commit"))))
+
+  (define (package-derivations-comparison-link system)
+    (let ((revisions
+           (assoc-ref change-details "revisions")))
+      (simple-format #f "https://data.qa.guix.gnu.org/compare/package-derivations?base_commit=~A&target_commit=~A&system=~A"
+                     (assoc-ref (assoc-ref revisions "base")
+                                "commit")
+                     (assoc-ref (assoc-ref revisions "target")
+                                "commit")
+                     system)))
+
+  (define (count-builds-by-status builds status)
+    (fold
+     (lambda (build result)
+       (+ result
+          (if (string=? status
+                        (assoc-ref build "status"))
+              1
+              0)))
+     0
+     builds))
+
   (layout
-   #:description "Guix Quality Assurance"
+   #:title (simple-format #f "Issue ~A" issue-number)
    #:body
    `((main
+      (div
+       (a (@ (href ,(simple-format #f "https://issues.guix.gnu.org/~A"
+                                   issue-number)))
+          "View issue on issues.guix.gnu.org"))
 
-      (table
-       (tbody
-        ,@(map
-           (match-lambda
-             ((system . build-count)
-              `(tr
-                (td ,system)
-                (td ,build-count))))
-           builds-by-system-excluding-cross-builds)))
+      (div
+       (a (@ (href ,(assoc-ref series "web_url")))
+          "View series on Patchwork"))
 
-      ,(assoc-ref series "web_url")))))
+      (div
+       (a (@ (href ,comparison-link))
+          "View Guix Data Service comparison"))
 
+      (div
+       (table
+        (thead
+         (tr
+          (th (@ (rowspan 3)) "System")
+          (th (@ (colspan 6)) "Testing")
+          (th))
+         (tr
+          (th (@ (colspan 3)) "Base")
+          (th (@ (colspan 3)) "With patches applied")
+          (th))
+         (tr
+          (th "Succeeding")
+          (th "Failing")
+          (th "Unknown")
+          (th "Succeeding")
+          (th "Failing")
+          (th "Unknown")
+          (th)))
+        (tbody
+         ,@(map
+            (match-lambda
+              ((system . builds)
+               (peek "BUILDS" builds)
+               `(tr
+                 (td (@ (class "monospace")) ,system)
+                 ,@(append-map
+                    (lambda (builds)
+                      (map
+                       (lambda (status)
+                         `(td ,(count-builds-by-status
+                                (or (assoc-ref builds system)
+                                    '())
+                                status)))
+                       '("succeeded" "failed" "scheduled")))
+                    (list base-builds
+                          target-builds))
+                 (td (a (@ (href ,(package-derivations-comparison-link system)))
+                        "View comparison")))))
+            target-builds))))))))