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

Improve the linking to build servers

Browse source 
Add a build-url function that returns the URL to use, and use this where
appropriate.
This commit is contained in:
Christopher Baines 2020-07-01 19:51:21 +01:00
parent 1e2fefa7cf
commit dc8b442e12
5 changed files with 37 additions and 30 deletions
Download patch file Download diff file Expand all files Collapse all files

26
guix-data-service/model/build.scm
View file

@ -19,6 +19,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (squee) #:use-module (squee)
#:use-module (json) #:use-module (json)
#:use-module (guix-data-service database)
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
#:export (select-build-stats #:export (select-build-stats
select-builds-with-context select-builds-with-context
@ -145,7 +146,8 @@ ORDER BY status"))
(define query (define query
(string-append (string-append
" "
SELECT builds.id, build_servers.url, derivations.file_name, SELECT builds.id, build_servers.url,
builds.build_server_build_id, derivations.file_name,
latest_build_status.timestamp, latest_build_status.status latest_build_status.timestamp, latest_build_status.status
FROM builds FROM builds
INNER JOIN build_servers ON build_servers.id = builds.build_server_id INNER JOIN build_servers ON build_servers.id = builds.build_server_id
@ -181,17 +183,17 @@ ON latest_build_status.build_id = builds.id
ORDER BY latest_build_status.timestamp DESC ORDER BY latest_build_status.timestamp DESC
LIMIT 100")) LIMIT 100"))
(exec-query conn (exec-query-with-null-handling conn
query query
`(,@(if revision-commit `(,@(if revision-commit
(list revision-commit) (list revision-commit)
'()) '())
,@(if system ,@(if system
(list system) (list system)
'()) '())
,@(if target ,@(if target
(list target) (list target)
'())))) '()))))
(define (select-builds-with-context-by-derivation-file-name (define (select-builds-with-context-by-derivation-file-name
conn derivation-file-name) conn derivation-file-name)

7
guix-data-service/web/build/html.scm
View file

@ -103,14 +103,15 @@
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
((build-id build-server-url derivation-file-name ((build-id build-server-url build-server-build-id
derivation-file-name
timestamp status) timestamp status)
`(tr `(tr
(td (@ (class "text-center")) (td (@ (class "text-center"))
(a (@ (href (a (@ (href
,(simple-format ,(build-url
#f "/build-server/~A/build?derivation_file_name=~A"
(assoc-ref build-server-options build-server-url) (assoc-ref build-server-options build-server-url)
build-server-build-id
derivation-file-name))) derivation-file-name)))
,(build-status-span status))) ,(build-status-span status)))
(td (a (@ (href ,derivation-file-name)) (td (a (@ (href ,derivation-file-name))

12
guix-data-service/web/html-utils.scm
View file

@ -25,6 +25,7 @@
build-status-value->display-string build-status-value->display-string
build-status-span build-status-span
build-url
build-status-alist->build-icon)) build-status-alist->build-icon))
(define (sexp-div sexp) (define (sexp-div sexp)
@ -67,6 +68,17 @@
("" . "Unknown")) ("" . "Unknown"))
value)) value))
(define (build-url build-server-id build-server-build-id derivation-file-name)
(if (string? build-server-build-id)
(simple-format
#f "/build-server/~A/build?build_server_build_id=~A"
build-server-id
build-server-build-id)
(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
build-server-id
derivation-file-name)))
(define (build-status-span status) (define (build-status-span status)
`(span (@ (class ,(string-append `(span (@ (class ,(string-append
"label label-" "label label-"

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

@ -1929,14 +1929,15 @@ figure {
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
((build-id build-server-url derivation-file-name ((build-id build-server-url build-server-build-id
derivation-file-name
timestamp status) timestamp status)
`(tr `(tr
(td (@ (class "text-center")) (td (@ (class "text-center"))
(a (@ (href (a (@ (href
,(simple-format ,(build-url
#f "/build-server/~A/build?derivation_file_name=~A"
(assoc-ref build-server-options build-server-url) (assoc-ref build-server-options build-server-url)
build-server-build-id
derivation-file-name))) derivation-file-name)))
,(build-status-span status))) ,(build-status-span status)))
(td (a (@ (href ,derivation-file-name)) (td (a (@ (href ,derivation-file-name))

15
guix-data-service/web/view/html.scm
View file

@ -634,21 +634,12 @@ time."
((build-server-id build-server-url ((build-server-id build-server-url
build-server-build-id build-server-build-id
timestamp status) timestamp status)
(define build-url
(if (string? build-server-build-id)
(simple-format
#f "/build-server/~A/build?build_server_build_id=~A"
build-server-id
build-server-build-id)
(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
build-server-id
(second derivation))))
`(div `(div
(@ (class "text-center")) (@ (class "text-center"))
(div (div
(a (@ (href ,build-url)) (a (@ (href ,(build-url build-server-id
build-server-build-id
(second derivation))))
,(build-status-span status))) ,(build-status-span status)))
(a (@ (style "display: inline-block; margin-top: 0.4em;") (a (@ (style "display: inline-block; margin-top: 0.4em;")
(href ,(simple-format (href ,(simple-format