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

Simplify the derivations page display

Browse source 
Displaing the outputs didn't add much, so focus on neatly displaying the
builds.
This commit is contained in:
Christopher Baines 2019-12-16 20:18:34 +00:00
parent 3305d85ef0
commit dc82112bf8
2 changed files with 36 additions and 50 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -639,6 +639,12 @@
#:minimum-builds (assq-ref query-parameters 'minimum_builds) #:minimum-builds (assq-ref query-parameters 'minimum_builds)
#:limit-results limit-results #:limit-results limit-results
#:after-name (assq-ref query-parameters 'after_name))) #:after-name (assq-ref query-parameters 'after_name)))
(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
@ -656,6 +662,7 @@
query-parameters query-parameters
(valid-systems conn) (valid-systems conn)
derivations derivations
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

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

@ -862,6 +862,7 @@ figure {
query-parameters query-parameters
valid-systems valid-systems
derivations derivations
build-server-urls
show-next-page? show-next-page?
#:key (path-base "/revision/") #:key (path-base "/revision/")
header-text header-text
@ -941,56 +942,34 @@ figure {
,@(map ,@(map
(match-lambda (match-lambda
((file-name system target builds outputs) ((file-name system target builds outputs)
(let ((build-server-ids `(tr
(sort (td (a (@ (href ,file-name))
(delete-duplicates ,(display-store-item-short file-name)))
(append (td (@ (style "font-family: monospace;"))
(map (lambda (build) ,system)
(assoc-ref build "build_server_id")) (td (@ (style "font-family: monospace;"))
(vector->list builds)) ,target)
(append-map (td
(lambda (output) (dl
(map (lambda (nar) ,@(append-map
(assoc-ref nar "build_server_id")) (lambda (build)
(vector->list (let ((build-server-id
(or (assoc-ref output "nars") (assoc-ref build "build_server_id")))
#())))) `((dt
(vector->list outputs)))) (@ (style "font-weight: unset;"))
<))) (a (@ (href
`(tr ,(assq-ref build-server-urls
(td (a (@ (href ,file-name)) build-server-id)))
,(display-store-item-short file-name))) ,(assq-ref build-server-urls
(td (@ (style "font-family: monospace;")) build-server-id)))
,system) (dd
(td (@ (style "font-family: monospace;")) (a (@ (href
,target) ,(simple-format
(td ,@(map #f "/build-server/~A/build?derivation_file_name=~A"
(lambda (build-server-id) build-server-id
`(div file-name)))
,@(map build-status-alist->build-icon ,(build-status-alist->build-icon build))))))
(filter (vector->list builds)))))))
(lambda (build)
(eq? build-server-id
(assoc-ref build "build_server_id")))
(vector->list builds)))
,@(map (lambda (output)
`(div
"Output: " ,(assoc-ref output "output_name")
,@(map (lambda (nar)
`(div
(a (@ (href
,(assoc-ref output "output_path")))
"Build server "
,(assoc-ref nar "build_server_id"))))
(filter
(lambda (nar)
(eq? build-server-id
(assoc-ref nar "build_server_id")))
(vector->list
(or (assoc-ref output "nars")
#()))))))
(vector->list outputs))))
build-server-ids))))))
derivations))) derivations)))
,@(if show-next-page? ,@(if show-next-page?
`((div `((div