[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: Improve the linking to build servers
|
From: |
Christopher Baines |
|
Subject: |
02/03: Improve the linking to build servers |
|
Date: |
Wed, 1 Jul 2020 18:10:00 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit dc8b442e128a1338656469e48af759574734f6d6
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Wed Jul 1 19:51:21 2020 +0100
Improve the linking to build servers
Add a build-url function that returns the URL to use, and use this where
appropriate.
---
guix-data-service/model/build.scm | 26 ++++++++++++++------------
guix-data-service/web/build/html.scm | 7 ++++---
guix-data-service/web/html-utils.scm | 12 ++++++++++++
guix-data-service/web/revision/html.scm | 7 ++++---
guix-data-service/web/view/html.scm | 15 +++------------
5 files changed, 37 insertions(+), 30 deletions(-)
diff --git a/guix-data-service/model/build.scm
b/guix-data-service/model/build.scm
index b9ba241..ac1e870 100644
--- a/guix-data-service/model/build.scm
+++ b/guix-data-service/model/build.scm
@@ -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,17 +183,17 @@ ON latest_build_status.build_id = builds.id
ORDER BY latest_build_status.timestamp DESC
LIMIT 100"))
- (exec-query conn
- query
- `(,@(if revision-commit
- (list revision-commit)
- '())
- ,@(if system
- (list system)
- '())
- ,@(if target
- (list target)
- '()))))
+ (exec-query-with-null-handling conn
+ query
+ `(,@(if revision-commit
+ (list revision-commit)
+ '())
+ ,@(if system
+ (list system)
+ '())
+ ,@(if target
+ (list target)
+ '()))))
(define (select-builds-with-context-by-derivation-file-name
conn derivation-file-name)
diff --git a/guix-data-service/web/build/html.scm
b/guix-data-service/web/build/html.scm
index c3d7c90..fdbfd7e 100644
--- a/guix-data-service/web/build/html.scm
+++ b/guix-data-service/web/build/html.scm
@@ -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))
diff --git a/guix-data-service/web/html-utils.scm
b/guix-data-service/web/html-utils.scm
index 6286b8f..bdafae3 100644
--- a/guix-data-service/web/html-utils.scm
+++ b/guix-data-service/web/html-utils.scm
@@ -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-"
diff --git a/guix-data-service/web/revision/html.scm
b/guix-data-service/web/revision/html.scm
index 60c6466..b2622b3 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -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))
diff --git a/guix-data-service/web/view/html.scm
b/guix-data-service/web/view/html.scm
index cf5421a..9dcd7aa 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -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