Improve the revision derivation-outputs page
Neaten up the display of the hashes, and add a reproducibility status column.
This commit is contained in:
parent
bdcba528fc
commit
34b3585b48
2 changed files with 63 additions and 13 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue