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

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

@ -19,6 +19,7 @@
#:use-module (ice-9 match)
#:use-module (squee)
#:use-module (json)
#:use-module (guix-data-service database)
#:use-module (guix-data-service model utils)
#:export (select-build-stats
select-builds-with-context
@ -145,7 +146,8 @@ ORDER BY status"))
(define query
(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
FROM builds
INNER JOIN build_servers ON build_servers.id = builds.build_server_id
@ -181,7 +183,7 @@ ON latest_build_status.build_id = builds.id
ORDER BY latest_build_status.timestamp DESC
LIMIT 100"))
(exec-query conn
(exec-query-with-null-handling conn
query
`(,@(if revision-commit
(list revision-commit)

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

@ -103,14 +103,15 @@
(tbody
,@(map
(match-lambda
((build-id build-server-url derivation-file-name
((build-id build-server-url build-server-build-id
derivation-file-name
timestamp status)
`(tr
(td (@ (class "text-center"))
(a (@ (href
,(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
,(build-url
(assoc-ref build-server-options build-server-url)
build-server-build-id
derivation-file-name)))
,(build-status-span status)))
(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-span
build-url
build-status-alist->build-icon))
(define (sexp-div sexp)
@ -67,6 +68,17 @@
("" . "Unknown"))
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)
`(span (@ (class ,(string-append
"label label-"

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

@ -1929,14 +1929,15 @@ figure {
(tbody
,@(map
(match-lambda
((build-id build-server-url derivation-file-name
((build-id build-server-url build-server-build-id
derivation-file-name
timestamp status)
`(tr
(td (@ (class "text-center"))
(a (@ (href
,(simple-format
#f "/build-server/~A/build?derivation_file_name=~A"
,(build-url
(assoc-ref build-server-options build-server-url)
build-server-build-id
derivation-file-name)))
,(build-status-span status)))
(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-build-id
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
(@ (class "text-center"))
(div
(a (@ (href ,build-url))
(a (@ (href ,(build-url build-server-id
build-server-build-id
(second derivation))))
,(build-status-span status)))
(a (@ (style "display: inline-block; margin-top: 0.4em;")
(href ,(simple-format