diff options
Diffstat (limited to 'guix-data-service/web/repository')
-rw-r--r-- | guix-data-service/web/repository/controller.scm | 11 | ||||
-rw-r--r-- | guix-data-service/web/repository/html.scm | 33 |
2 files changed, 39 insertions, 5 deletions
diff --git a/guix-data-service/web/repository/controller.scm b/guix-data-service/web/repository/controller.scm index 45fd6bd..ffa9e40 100644 --- a/guix-data-service/web/repository/controller.scm +++ b/guix-data-service/web/repository/controller.scm @@ -22,6 +22,8 @@ #:use-module (guix-data-service web render) #:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web util) + #:use-module (guix-data-service model utils) + #:use-module (guix-data-service model build-server) #:use-module (guix-data-service model package) #:use-module (guix-data-service model git-branch) #:use-module (guix-data-service model git-repository) @@ -118,7 +120,13 @@ branch-name "x86_64-linux" "x86_64-linux" - package-name))) + package-name)) + (build-server-urls + (group-to-alist + (match-lambda + ((id url lookup-all-derivations) + (cons id url))) + (select-build-servers conn)))) (case (most-appropriate-mime-type '(application/json text/html) mime-types) @@ -146,6 +154,7 @@ repository-id branch-name package-name + build-server-urls package-derivations)))))) (('GET "repository" repository-id "branch" branch-name "latest-processed-revision") (let ((commit-hash diff --git a/guix-data-service/web/repository/html.scm b/guix-data-service/web/repository/html.scm index ece92bf..ec31d06 100644 --- a/guix-data-service/web/repository/html.scm +++ b/guix-data-service/web/repository/html.scm @@ -19,6 +19,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-19) #:use-module (ice-9 match) + #:use-module (guix-data-service web html-utils) #:use-module (guix-data-service web view html) #:export (view-git-repository view-branches @@ -282,6 +283,7 @@ (define (view-branch-package-derivations git-repository-id branch-name package-name + build-server-urls derivations-by-revision-range) (define versions-list (pair-fold (match-lambda* @@ -332,9 +334,10 @@ (thead (tr (th (@ (class "col-sm-1")) "Version") - (th (@ (class "col-sm-5")) "Derivation") - (th (@ (class "col-sm-1")) "From") - (th (@ (class "col-sm-1")) "To") + (th (@ (class "col-sm-4")) "Derivation") + (th (@ (class "col-sm-2")) "Builds") + (th (@ (class "col-sm-2")) "From") + (th (@ (class "col-sm-2")) "To") (th (@ (class "col-sm-1")) ""))) (tbody ,@(let* ((times-in-seconds @@ -360,7 +363,8 @@ first-guix-revision-commit first-datetime last-guix-revision-commit - last-datetime) + last-datetime + builds) next-derivation-file-name) `((tr (@ (style "border-bottom: 0;")) @@ -373,6 +377,27 @@ (td (a (@ (href ,derivation-file-name)) ,(display-store-item derivation-file-name))) + (td + (dl + ,@(append-map + (lambda (build) + (let ((build-server-id + (assoc-ref build "build_server_id"))) + `((dt + (@ (style "font-weight: unset;")) + (a (@ (href + ,(assq-ref build-server-urls + build-server-id))) + ,(assq-ref build-server-urls + build-server-id))) + (dd + (a (@ (href + ,(simple-format + #f "/build-server/~A/build?derivation_file_name=~A" + build-server-id + derivation-file-name))) + ,(build-status-alist->build-icon build)))))) + builds))) (td (a (@ (href ,(string-append "/revision/" first-guix-revision-commit))) ,first-datetime)) |