diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-10-11 21:19:00 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-10-11 21:19:00 +0100 |
| commit | 4231f11cb8d5f556e38715878624cb0b88349b13 (patch) | |
| tree | 545198cf1cec5da31d873d353bcf9cc4896612c5 /guix-data-service/web | |
| parent | d05a7397fb3b4fc18cd5fc992183252d6b154e8a (diff) | |
| download | data-service-4231f11cb8d5f556e38715878624cb0b88349b13.tar data-service-4231f11cb8d5f556e38715878624cb0b88349b13.tar.gz | |
Tweak linking to build servers
Move the logic from different places in the view code, and also start
supporting linking to guix.cbaines.net builds. I'm unsure quite how to
generalise this, but just starting doing it is probably the way forward.
Diffstat (limited to 'guix-data-service/web')
| -rw-r--r-- | guix-data-service/web/build/html.scm | 8 | ||||
| -rw-r--r-- | guix-data-service/web/html-utils.scm | 18 | ||||
| -rw-r--r-- | guix-data-service/web/revision/html.scm | 8 | ||||
| -rw-r--r-- | guix-data-service/web/view/html.scm | 8 |
4 files changed, 27 insertions, 15 deletions
diff --git a/guix-data-service/web/build/html.scm b/guix-data-service/web/build/html.scm index f9939af..461f44a 100644 --- a/guix-data-service/web/build/html.scm +++ b/guix-data-service/web/build/html.scm @@ -116,11 +116,9 @@ (td (a (@ (href ,derivation-file-name)) ,(display-store-item-short derivation-file-name))) (td ,timestamp) - (td (a (@ (href ,(simple-format - #f "~Abuild/~A" + (td (a (@ (href ,(build-server-link-url build-server-url - (string-drop - derivation-file-name - (string-length "/gnu/store/"))))) + build-server-build-id + derivation-file-name))) "View build on " ,build-server-url))))) builds))))))))) diff --git a/guix-data-service/web/html-utils.scm b/guix-data-service/web/html-utils.scm index bdafae3..5fa1ad4 100644 --- a/guix-data-service/web/html-utils.scm +++ b/guix-data-service/web/html-utils.scm @@ -26,6 +26,7 @@ build-status-value->display-string build-status-span build-url + build-server-link-url build-status-alist->build-icon)) (define (sexp-div sexp) @@ -79,6 +80,23 @@ build-server-id derivation-file-name))) +(define (build-server-link-url url-base + build-server-build-id + derivation-file-name) + (string-append + url-base + (if (string-suffix? "/" url-base) + "" + "/") + "build/" + (if (and (string? build-server-build-id) + (eq? (string-length build-server-build-id) + 36)) ; crude UUID check + build-server-build-id + (string-drop + derivation-file-name + (string-length "/gnu/store/"))))) + (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 571f6f6..b72dd9f 100644 --- a/guix-data-service/web/revision/html.scm +++ b/guix-data-service/web/revision/html.scm @@ -1978,12 +1978,10 @@ figure { (td (a (@ (href ,derivation-file-name)) ,(display-store-item-short derivation-file-name))) (td ,timestamp) - (td (a (@ (href ,(simple-format - #f "~Abuild/~A" + (td (a (@ (href ,(build-server-link-url build-server-url - (string-drop - derivation-file-name - (string-length "/gnu/store/"))))) + build-server-build-id + derivation-file-name))) "View build on " ,build-server-url))))) builds))))))))) diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index 70893c4..78a6da1 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -671,12 +671,10 @@ time." (second derivation)))) ,(build-status-span status))) (a (@ (style "display: inline-block; margin-top: 0.4em;") - (href ,(simple-format - #f "~Abuild/~A" + (href ,(build-server-link-url build-server-url - (string-drop - (second derivation) - (string-length "/gnu/store/"))))) + build-server-build-id + (second derivation)))) "View build on " ,build-server-url)))) builds))) (div |