aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/web/revision/controller.scm9
-rw-r--r--guix-data-service/web/revision/html.scm67
2 files changed, 63 insertions, 13 deletions
diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index 63316a3..bc49703 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -28,6 +28,7 @@
#:use-module (guix-data-service web sxml)
#:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web util)
+ #:use-module (guix-data-service model utils)
#:use-module (guix-data-service jobs load-new-guix-revision)
#:use-module (guix-data-service model build)
#:use-module (guix-data-service model build-server)
@@ -653,6 +654,7 @@
#:sxml (view-revision-derivation-outputs commit-hash
query-parameters
'()
+ '()
#:path-base path-base
#:header-text header-text
#:header-link header-link))))
@@ -668,6 +670,12 @@
(assq-ref query-parameters 'reproducibility_status)
#:limit-results limit-results
#:after-path (assq-ref query-parameters 'after_path)))
+ (build-server-urls
+ (group-to-alist
+ (match-lambda
+ ((id url lookup-all-derivations)
+ (cons id url)))
+ (select-build-servers conn)))
(show-next-page?
(if all-results
#f
@@ -684,6 +692,7 @@
#:sxml (view-revision-derivation-outputs commit-hash
query-parameters
derivation-outputs
+ build-server-urls
show-next-page?
#:path-base path-base
#:header-text header-text
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index 546538e..ce79f52 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -21,6 +21,7 @@
#:use-module (texinfo)
#:use-module (texinfo html)
#:use-module (json)
+ #:use-module (guix-data-service model utils)
#:use-module (guix-data-service web util)
#:use-module (guix-data-service web html-utils)
#:use-module (guix-data-service web query-parameters)
@@ -769,6 +770,7 @@
(define* (view-revision-derivation-outputs commit-hash
query-parameters
derivation-outputs
+ build-server-urls
show-next-page?
#:key (path-base "/revision/")
header-text
@@ -834,9 +836,9 @@
(@ (class "table"))
(thead
(tr
- (th "Path")
- (th "Hash")
- (th "Nars")))
+ (th (@ (class "col-sm-5")) "Path")
+ (th (@ (class "col-sm-5")) "Data")
+ (th (@ (class "col-sm-2")) "Reproducibility Status")))
(tbody
,@(map
(match-lambda
@@ -845,17 +847,56 @@
(td (a (@ (href ,path))
,(display-store-item-short path)))
(td
- ,@(if
- (null? hash-algorithm)
- '()
- `(,hash)))
+ (dl
+ ,@(if
+ (null? hash-algorithm)
+ (append-map
+ (match-lambda
+ ((hash . nars)
+ `((dt
+ (a (@ (style "font-family: monospace;")
+ (href ,(string-append
+ path "/narinfos")))
+ ,hash))
+ (dd
+ (ul
+ (@ (class "list-inline"))
+ ,@(map (lambda (nar)
+ `(li
+ ,(assq-ref build-server-urls
+ (assoc-ref nar "build_server_id"))))
+ nars))))))
+ (group-to-alist
+ (lambda (nar)
+ (cons (assoc-ref nar "hash")
+ nar))
+ (vector->list nars)))
+ `(,hash))))
(td
- ,@(map (lambda (nar)
- `(div
- ,(assoc-ref nar "build_server_id")
- " "
- ,(assoc-ref nar "hash")))
- (vector->list nars))))))
+ ,(let* ((hashes
+ (delete-duplicates
+ (map (lambda (nar)
+ (assoc-ref nar "hash"))
+ (vector->list nars))))
+ (build-servers
+ (delete-duplicates
+ (map (lambda (nar)
+ (assoc-ref nar "build_server_id"))
+ (vector->list nars))))
+ (hash-count
+ (length hashes))
+ (build-server-count
+ (length build-servers)))
+ (cond
+ ((or (eq? hash-count 0)
+ (eq? build-server-count 1))
+ "Unknown")
+ ((eq? hash-count 1)
+ '(span (@ (class "text-success"))
+ "Reproducible"))
+ ((> hash-count 1)
+ '(span (@ (class "text-danger"))
+ "Unreproducible"))))))))
derivation-outputs)))
,@(if show-next-page?
`((div