1 files changed, 94 insertions, 1 deletions
diff --git a/guix-qa-frontpage/view/shared.scm b/guix-qa-frontpage/view/shared.scm
index 3cf92b8..e1f26ab 100644
--- a/guix-qa-frontpage/view/shared.scm
+++ b/guix-qa-frontpage/view/shared.scm
@@ -29,7 +29,8 @@
   #:export (package-changes-view
             package-cross-changes-view
             package-changes-summary-table
-            package-cross-changes-summary-table))
+            package-cross-changes-summary-table
+            package-reproducibility-table))
 
 (define (builds->overall-status builds)
   (if (eq? #f builds)
@@ -947,3 +948,95 @@
                                               "target revision.")))))))))))
                             params)))
                         '()))))))))
+
+(define (package-reproducibility-table package-reproducibility)
+  `(table
+    (thead
+     (tr
+      (th (@ (rowspan 2))
+          "System")
+      (th (@ (colspan 4))
+          "Package reproducibility"))
+     (tr (th "Matching")
+         (th "Not matching")
+         (th "Unknown")
+         (th (@ (style "min-width: 20em;")))))
+    (tbody
+     ,@(map
+        (match-lambda
+          ((system . details)
+           (let* ((matching
+                   (or (assoc-ref details "matching")
+                       0))
+                  (not-matching
+                   (or (assoc-ref details "not-matching")
+                       0))
+                  (unknown
+                   (or (assoc-ref details "unknown")
+                       0))
+                  (total
+                   (+ matching not-matching unknown))
+                  (matching-percent
+                   (round (/ (* 100 matching) total)))
+                  (not-matching-percent
+                   (round (/ (* 100 not-matching) total)))
+                  (unknown-percent
+                   (- 100 (+ matching-percent not-matching-percent))))
+             `(tr
+               (td
+                (@ (style "font-family: monospace;"))
+                ,system)
+               (td (a (@ (href
+                          ,(string-append
+                            "https://data.qa.guix.gnu.org/revision/"
+                            (assoc-ref package-reproducibility "commit")
+                            "/package-derivation-outputs"
+                            "?output_consistency=matching&system="
+                            system)))
+                      ,matching))
+               (td (a (@ (href
+                          ,(string-append
+                            "https://data.qa.guix.gnu.org/revision/"
+                            (assoc-ref package-reproducibility "commit")
+                            "/package-derivation-outputs"
+                            "?output_consistency=not-matching&system="
+                            system)))
+                      ,not-matching))
+               (td (a (@ (href
+                          ,(string-append
+                            "https://data.qa.guix.gnu.org/revision/"
+                            (assoc-ref package-reproducibility "commit")
+                            "/package-derivation-outputs"
+                            "?output_consistency=unknown&system="
+                            system)))
+                      ,unknown))
+               (td
+                (span (@ (style ,(string-append
+                                  "display: inline-block;"
+                                  "background-color: green;"
+                                  "padding: 0.5em 0 0.5em 0;"
+                                  (simple-format #f "width: ~A%;"
+                                                 matching-percent))))
+                      "")
+                (span (@ (style ,(string-append
+                                  "display: inline-block;"
+                                  "background-color: red;"
+                                  "padding: 0.5em 0 0.5em 0;"
+                                  (simple-format #f "width: ~A%;"
+                                                 not-matching-percent))))
+                      "")
+                (span (@ (style ,(string-append
+                                  "display: inline-block;"
+                                  "background-color: grey;"
+                                  "padding: 0.5em 0 0.5em 0;"
+                                  (simple-format #f "width: ~A%;"
+                                                 unknown-percent))))
+                      ""))))))
+        (sort
+         (filter
+          (match-lambda
+            ((system . _)
+             (not (member system '("powerpc-linux" "mips64el-linux")))))
+          (assoc-ref package-reproducibility "systems"))
+         (lambda (a b)
+           (string<? (car a) (car b))))))))