diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index e066278..c475d83 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -249,7 +249,8 @@ GROUP BY derivation_source_files.store_path")) target_guix_revision_id #:key (systems #f) - (targets #f)) + (targets #f) + (include-builds? #t)) (define extra-constraints (string-append (if systems @@ -277,37 +278,85 @@ GROUP BY derivation_source_files.store_path")) (string-append " WITH base_packages AS ( SELECT packages.*, derivations.file_name, - package_derivations.system, package_derivations.target + package_derivations.system, package_derivations.target, + derivations_by_output_details_set.derivation_output_details_set_id FROM packages INNER JOIN package_derivations ON packages.id = package_derivations.package_id INNER JOIN derivations ON package_derivations.derivation_id = derivations.id + INNER JOIN derivations_by_output_details_set + ON derivations.id = derivations_by_output_details_set.derivation_id WHERE package_derivations.id IN ( SELECT guix_revision_package_derivations.package_derivation_id FROM guix_revision_package_derivations WHERE revision_id = $1 - )" extra-constraints -"), target_packages AS ( + )" extra-constraints " +), target_packages AS ( SELECT packages.*, derivations.file_name, - package_derivations.system, package_derivations.target + package_derivations.system, package_derivations.target, + derivations_by_output_details_set.derivation_output_details_set_id FROM packages INNER JOIN package_derivations ON packages.id = package_derivations.package_id INNER JOIN derivations ON package_derivations.derivation_id = derivations.id + INNER JOIN derivations_by_output_details_set + ON derivations.id = derivations_by_output_details_set.derivation_id WHERE package_derivations.id IN ( SELECT guix_revision_package_derivations.package_derivation_id FROM guix_revision_package_derivations WHERE revision_id = $2 - )" extra-constraints -") + )" extra-constraints " +) SELECT base_packages.name, base_packages.version, base_packages.package_metadata_id, base_packages.file_name, - base_packages.system, base_packages.target, + base_packages.system, base_packages.target," + (if include-builds? + " + ( + SELECT 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 != base_packages.file_name + ) + ORDER BY latest_build_status.timestamp + ) + FROM builds + INNER JOIN latest_build_status + ON builds.id = latest_build_status.build_id + WHERE builds.derivation_output_details_set_id = + base_packages.derivation_output_details_set_id + ) AS base_builds," + "") + " target_packages.name, target_packages.version, target_packages.package_metadata_id, target_packages.file_name, - target_packages.system, target_packages.target + target_packages.system, target_packages.target" + (if include-builds? + ", + ( + SELECT 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 != target_packages.file_name + ) + ORDER BY latest_build_status.timestamp + ) + FROM builds + INNER JOIN latest_build_status + ON builds.id = latest_build_status.build_id + WHERE builds.derivation_output_details_set_id = + target_packages.derivation_output_details_set_id + ) AS target_builds" + "") + " FROM base_packages FULL OUTER JOIN target_packages ON base_packages.name = target_packages.name @@ -397,7 +446,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v (apply values (fold (lambda (row result) - (let-values (((base-row-part target-row-part) (split-at row 6))) + (let-values (((base-row-part target-row-part) (split-at row 7))) (match result ((base-package-data target-package-data) (list (add-data-to-vhash base-row-part base-package-data) @@ -421,7 +470,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v result))))) '() (map (match-lambda - ((base-name base-version _ _ _ _ target-name target-version _ _ _ _) + ((base-name base-version _ _ _ _ _ target-name target-version _ _ _ _ _) (if (string-null? base-name) (cons target-name target-version) (cons base-name base-version)))) @@ -551,10 +600,13 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v (if (null? lst) '() `(,(match (first lst) - ((derivation-file-name system target) + ((derivation-file-name system target builds) `((system . ,system) (target . ,target) - (derivation-file-name . ,derivation-file-name)))) + (derivation-file-name . ,derivation-file-name) + (builds . ,(if (string-null? builds) + #() + (json-string->scm builds)))))) ,@(derivation-system-and-target-list->alist (cdr lst))))) (list->vector diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index f2d7e46..7d2785a 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -34,6 +34,7 @@ #:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service model guix-revision) #:use-module (guix-data-service model derivation) + #:use-module (guix-data-service model build-server) #:use-module (guix-data-service model build-status) #:use-module (guix-data-service model lint-warning-message) #:use-module (guix-data-service web compare html) @@ -528,13 +529,17 @@ valid-systems)) (targets (with-thread-postgresql-connection - valid-targets))) + valid-targets)) + (build-server-urls + (with-thread-postgresql-connection + select-build-server-urls-by-id))) (render-html #:sxml (compare/package-derivations query-parameters systems (valid-targets->options targets) build-status-strings + build-server-urls '()))))) (let ((base-commit (assq-ref query-parameters 'base_commit)) @@ -550,7 +555,10 @@ (commit->revision-id conn base-commit) (commit->revision-id conn target-commit) #:systems systems - #:targets targets))))) + #:targets targets)))) + (build-server-urls + (with-thread-postgresql-connection + select-build-server-urls-by-id))) (let ((names-and-versions (package-derivation-data->names-and-versions data))) (let-values @@ -580,6 +588,7 @@ systems (valid-targets->options targets) build-status-strings + build-server-urls derivation-changes) #:extra-headers http-headers-for-unchanging-content))))))))))) diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm index 7c34d7b..f4105c1 100644 --- a/guix-data-service/web/compare/html.scm +++ b/guix-data-service/web/compare/html.scm @@ -22,6 +22,7 @@ #:use-module (texinfo) #:use-module (texinfo html) #:use-module (guix-data-service web query-parameters) + #:use-module (guix-data-service web html-utils) #:use-module (guix-data-service web view html) #:export (compare compare/derivation @@ -602,6 +603,7 @@ valid-systems valid-targets valid-build-statuses + build-server-urls derivation-changes) (layout #:body @@ -681,7 +683,7 @@ (th "Version") (th "System") (th "Target") - (th (@ (class "col-xs-5")) "Derivations") + (th (@ (class "col-xs-5")) "Derivations (with build statuses)") (th ""))) (tbody ,@(append-map @@ -704,18 +706,24 @@ (map (match-lambda ((system . target) - (let ((base-derivation-file-name - (assq-ref (find (lambda (details) - (and (string=? (assq-ref details 'system) system) - (string=? (assq-ref details 'target) target))) - (vector->list base-derivations)) - 'derivation-file-name)) - (target-derivation-file-name - (assq-ref (find (lambda (details) - (and (string=? (assq-ref details 'system) system) - (string=? (assq-ref details 'target) target))) - (vector->list target-derivations)) - 'derivation-file-name))) + (let* ((base-entry + (find (lambda (details) + (and (string=? (assq-ref details 'system) system) + (string=? (assq-ref details 'target) target))) + (vector->list base-derivations))) + (base-derivation-file-name + (assq-ref base-entry 'derivation-file-name)) + (base-builds + (assq-ref base-entry 'builds)) + (target-entry + (find (lambda (details) + (and (string=? (assq-ref details 'system) system) + (string=? (assq-ref details 'target) target))) + (vector->list target-derivations))) + (target-derivation-file-name + (assq-ref target-entry 'derivation-file-name)) + (target-builds + (assq-ref target-entry 'builds))) `((td (samp (@ (style "white-space: nowrap;")) ,system)) (td (samp (@ (style "white-space: nowrap;")) @@ -725,6 +733,8 @@ (href ,base-derivation-file-name)) (span (@ (class "text-danger glyphicon glyphicon-minus pull-left") (style "font-size: 1.5em; padding-right: 0.4em;"))) + ,@(build-statuses->build-status-labels + (vector->list base-builds)) ,(display-store-item-short base-derivation-file-name))) '()) ,@(if target-derivation-file-name @@ -732,7 +742,9 @@ (href ,target-derivation-file-name)) (span (@ (class "text-success glyphicon glyphicon-plus pull-left") (style "font-size: 1.5em; padding-right: 0.4em;"))) - ,(and=> target-derivation-file-name display-store-item-short))) + ,@(build-statuses->build-status-labels + (vector->list target-builds)) + ,(display-store-item-short target-derivation-file-name))) '())) (td (@ (style "vertical-align: middle;")) ,@(if (and base-derivation-file-name