Improve the revision derivation-outputs page

Neaten up the display of the hashes, and add a reproducibility status column.
This commit is contained in:
Christopher Baines 2019-12-15 15:52:11 +00:00
parent bdcba528fc
commit 34b3585b48
2 changed files with 63 additions and 13 deletions

View file

@ -28,6 +28,7 @@
#:use-module (guix-data-service web sxml) #:use-module (guix-data-service web sxml)
#:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web util) #: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 jobs load-new-guix-revision)
#:use-module (guix-data-service model build) #:use-module (guix-data-service model build)
#:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-server)
@ -653,6 +654,7 @@
#:sxml (view-revision-derivation-outputs commit-hash #:sxml (view-revision-derivation-outputs commit-hash
query-parameters query-parameters
'() '()
'()
#:path-base path-base #:path-base path-base
#:header-text header-text #:header-text header-text
#:header-link header-link)))) #:header-link header-link))))
@ -668,6 +670,12 @@
(assq-ref query-parameters 'reproducibility_status) (assq-ref query-parameters 'reproducibility_status)
#:limit-results limit-results #:limit-results limit-results
#:after-path (assq-ref query-parameters 'after_path))) #: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? (show-next-page?
(if all-results (if all-results
#f #f
@ -684,6 +692,7 @@
#:sxml (view-revision-derivation-outputs commit-hash #:sxml (view-revision-derivation-outputs commit-hash
query-parameters query-parameters
derivation-outputs derivation-outputs
build-server-urls
show-next-page? show-next-page?
#:path-base path-base #:path-base path-base
#:header-text header-text #:header-text header-text

View file

@ -21,6 +21,7 @@
#:use-module (texinfo) #:use-module (texinfo)
#:use-module (texinfo html) #:use-module (texinfo html)
#:use-module (json) #:use-module (json)
#:use-module (guix-data-service model utils)
#:use-module (guix-data-service web util) #:use-module (guix-data-service web util)
#:use-module (guix-data-service web html-utils) #:use-module (guix-data-service web html-utils)
#:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web query-parameters)
@ -769,6 +770,7 @@
(define* (view-revision-derivation-outputs commit-hash (define* (view-revision-derivation-outputs commit-hash
query-parameters query-parameters
derivation-outputs derivation-outputs
build-server-urls
show-next-page? show-next-page?
#:key (path-base "/revision/") #:key (path-base "/revision/")
header-text header-text
@ -834,9 +836,9 @@
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
(th "Path") (th (@ (class "col-sm-5")) "Path")
(th "Hash") (th (@ (class "col-sm-5")) "Data")
(th "Nars"))) (th (@ (class "col-sm-2")) "Reproducibility Status")))
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
@ -845,17 +847,56 @@
(td (a (@ (href ,path)) (td (a (@ (href ,path))
,(display-store-item-short path))) ,(display-store-item-short path)))
(td (td
,@(if (dl
(null? hash-algorithm) ,@(if
'() (null? hash-algorithm)
`(,hash))) (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 (td
,@(map (lambda (nar) ,(let* ((hashes
`(div (delete-duplicates
,(assoc-ref nar "build_server_id") (map (lambda (nar)
" " (assoc-ref nar "hash"))
,(assoc-ref nar "hash"))) (vector->list nars))))
(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))) derivation-outputs)))
,@(if show-next-page? ,@(if show-next-page?
`((div `((div