diff options
| -rw-r--r-- | guix-data-service/model/package.scm | 67 | ||||
| -rw-r--r-- | guix-data-service/web/repository/controller.scm | 11 | ||||
| -rw-r--r-- | guix-data-service/web/repository/html.scm | 33 |
3 files changed, 96 insertions, 15 deletions
diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm index 0253a5a..fbb1654 100644 --- a/guix-data-service/model/package.scm +++ b/guix-data-service/model/package.scm @@ -2,6 +2,7 @@ #:use-module (srfi srfi-1) #:use-module (ice-9 vlist) #:use-module (ice-9 match) + #:use-module (json) #:use-module (squee) #:use-module (guix inferior) #:use-module (guix-data-service model utils) @@ -243,18 +244,38 @@ ORDER BY first_datetime DESC, package_version DESC" system target package-name) - (exec-query - conn - " + (define query + " SELECT package_version, derivations.file_name, first_guix_revisions.commit AS first_guix_revision_commit, first_git_branches.datetime AS first_datetime, last_guix_revisions.commit AS last_guix_revision_commit, - last_git_branches.datetime AS last_datetime + last_git_branches.datetime AS last_datetime, + JSON_AGG( + json_build_object( + 'build_server_id', builds.build_server_id, + 'status', latest_build_status.status, + 'timestamp', latest_build_status.timestamp, + 'build_for_equivalent_derivation', + builds.derivation_file_name != derivations.file_name + ) + ORDER BY latest_build_status.timestamp + ) AS builds FROM package_derivations_by_guix_revision_range INNER JOIN derivations ON package_derivations_by_guix_revision_range.derivation_id = derivations.id +INNER JOIN derivations_by_output_details_set + ON derivations_by_output_details_set.derivation_id = derivations.id +LEFT OUTER JOIN builds + ON derivations_by_output_details_set.derivation_output_details_set_id = + builds.derivation_output_details_set_id +LEFT OUTER JOIN ( + SELECT DISTINCT ON (build_id) * + FROM build_status + ORDER BY build_id, timestamp DESC +) AS latest_build_status + ON builds.id = latest_build_status.build_id INNER JOIN guix_revisions AS first_guix_revisions ON first_guix_revision_id = first_guix_revisions.id INNER JOIN git_branches AS first_git_branches @@ -272,9 +293,35 @@ AND first_git_branches.name = $3 AND last_git_branches.name = $3 AND package_derivations_by_guix_revision_range.system = $4 AND package_derivations_by_guix_revision_range.target = $5 -ORDER BY first_datetime DESC, package_version DESC" - (list package-name - (number->string git-repository-id) - branch-name - system - target))) +GROUP BY 1, 2, 3, 4, 5, 6 +ORDER BY first_datetime DESC, package_version DESC") + + (map (match-lambda + ((version derivation-file-name + first-guix-revision-commit + first-datetime + last-guix-revision-commit + last-datetime + builds-json) + (list version + derivation-file-name + first-guix-revision-commit + first-datetime + last-guix-revision-commit + last-datetime + (if (string-null? builds-json) + '() + (filter (lambda (build) + (not (eq? (assoc-ref build "build_server_id") + #nil))) + (vector->list + (json-string->scm builds-json))))))) + (exec-query + conn + query + (list package-name + (number->string git-repository-id) + branch-name + system + target)))) + 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)) |