cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Improve the revision derivation-outputs page

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

9
guix-data-service/web/revision/controller.scm
View file

@ -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

67
guix-data-service/web/revision/html.scm
View file

@ -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