[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
05/05: Show build information when comparing package derivations
|
From: |
Christopher Baines |
|
Subject: |
05/05: Show build information when comparing package derivations |
|
Date: |
Sat, 31 Oct 2020 11:56:09 -0400 (EDT) |
cbaines pushed a commit to branch master
in repository data-service.
commit e394d1d6ad51aa992a62519842511947619d920a
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sat Oct 31 15:55:11 2020 +0000
Show build information when comparing package derivations
As this is useful to see, as it can indicate that a change to the derivation
has led to the builds to start failing/succeeding.
---
guix-data-service/comparison.scm | 78 +++++++++++++++++++++++-----
guix-data-service/web/compare/controller.scm | 13 ++++-
guix-data-service/web/compare/html.scm | 40 +++++++++-----
3 files changed, 102 insertions(+), 29 deletions(-)
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