cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Show build information when comparing package derivations

Browse source 
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.
This commit is contained in:
Christopher Baines 2020-10-31 15:55:11 +00:00
parent 1573fe566b
commit e394d1d6ad
3 changed files with 102 additions and 29 deletions
Download patch file Download diff file Expand all files Collapse all files

78
guix-data-service/comparison.scm
View file

@ -249,7 +249,8 @@ GROUP BY derivation_source_files.store_path"))
target_guix_revision_id target_guix_revision_id
#:key #:key
(systems #f) (systems #f)
(targets #f)) (targets #f)
(include-builds? #t))
(define extra-constraints (define extra-constraints
(string-append (string-append
(if systems (if systems
@ -277,37 +278,85 @@ GROUP BY derivation_source_files.store_path"))
(string-append " (string-append "
WITH base_packages AS ( WITH base_packages AS (
SELECT packages.*, derivations.file_name, 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 FROM packages
INNER JOIN package_derivations INNER JOIN package_derivations
ON packages.id = package_derivations.package_id ON packages.id = package_derivations.package_id
INNER JOIN derivations INNER JOIN derivations
ON package_derivations.derivation_id = derivations.id 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 ( WHERE package_derivations.id IN (
SELECT guix_revision_package_derivations.package_derivation_id SELECT guix_revision_package_derivations.package_derivation_id
FROM guix_revision_package_derivations FROM guix_revision_package_derivations
WHERE revision_id = $1 WHERE revision_id = $1
)" extra-constraints )" extra-constraints "
"), target_packages AS ( ), target_packages AS (
SELECT packages.*, derivations.file_name, 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 FROM packages
INNER JOIN package_derivations INNER JOIN package_derivations
ON packages.id = package_derivations.package_id ON packages.id = package_derivations.package_id
INNER JOIN derivations INNER JOIN derivations
ON package_derivations.derivation_id = derivations.id 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 ( WHERE package_derivations.id IN (
SELECT guix_revision_package_derivations.package_derivation_id SELECT guix_revision_package_derivations.package_derivation_id
FROM guix_revision_package_derivations FROM guix_revision_package_derivations
WHERE revision_id = $2 WHERE revision_id = $2
)" extra-constraints )" extra-constraints "
") )
SELECT base_packages.name, base_packages.version, SELECT base_packages.name, base_packages.version,
base_packages.package_metadata_id, base_packages.file_name, 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.name, target_packages.version,
target_packages.package_metadata_id, target_packages.file_name, 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 FROM base_packages
FULL OUTER JOIN target_packages FULL OUTER JOIN target_packages
ON base_packages.name = target_packages.name 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 (apply values
(fold (lambda (row result) (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 (match result
((base-package-data target-package-data) ((base-package-data target-package-data)
(list (add-data-to-vhash base-row-part base-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))))) result)))))
'() '()
(map (match-lambda (map (match-lambda
((base-name base-version _ _ _ _ target-name target-version _ _ _ _) ((base-name base-version _ _ _ _ _ target-name target-version _ _ _ _ _)
(if (string-null? base-name) (if (string-null? base-name)
(cons target-name target-version) (cons target-name target-version)
(cons base-name base-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) (if (null? lst)
'() '()
`(,(match (first lst) `(,(match (first lst)
((derivation-file-name system target) ((derivation-file-name system target builds)
`((system . ,system) `((system . ,system)
(target . ,target) (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))))) ,@(derivation-system-and-target-list->alist (cdr lst)))))
(list->vector (list->vector

13
guix-data-service/web/compare/controller.scm
View file

@ -34,6 +34,7 @@
#:use-module (guix-data-service jobs load-new-guix-revision) #:use-module (guix-data-service jobs load-new-guix-revision)
#:use-module (guix-data-service model guix-revision) #:use-module (guix-data-service model guix-revision)
#:use-module (guix-data-service model derivation) #: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 build-status)
#:use-module (guix-data-service model lint-warning-message) #:use-module (guix-data-service model lint-warning-message)
#:use-module (guix-data-service web compare html) #:use-module (guix-data-service web compare html)
@ -528,13 +529,17 @@
valid-systems)) valid-systems))
(targets (targets
(with-thread-postgresql-connection (with-thread-postgresql-connection
valid-targets))) valid-targets))
(build-server-urls
(with-thread-postgresql-connection
select-build-server-urls-by-id)))
(render-html (render-html
#:sxml (compare/package-derivations #:sxml (compare/package-derivations
query-parameters query-parameters
systems systems
(valid-targets->options targets) (valid-targets->options targets)
build-status-strings build-status-strings
build-server-urls
'()))))) '())))))
(let ((base-commit (assq-ref query-parameters 'base_commit)) (let ((base-commit (assq-ref query-parameters 'base_commit))
@ -550,7 +555,10 @@
(commit->revision-id conn base-commit) (commit->revision-id conn base-commit)
(commit->revision-id conn target-commit) (commit->revision-id conn target-commit)
#:systems systems #:systems systems
#:targets targets))))) #:targets targets))))
(build-server-urls
(with-thread-postgresql-connection
select-build-server-urls-by-id)))
(let ((names-and-versions (let ((names-and-versions
(package-derivation-data->names-and-versions data))) (package-derivation-data->names-and-versions data)))
(let-values (let-values
@ -580,6 +588,7 @@
systems systems
(valid-targets->options targets) (valid-targets->options targets)
build-status-strings build-status-strings
build-server-urls
derivation-changes) derivation-changes)
#:extra-headers http-headers-for-unchanging-content))))))))))) #:extra-headers http-headers-for-unchanging-content)))))))))))

34
guix-data-service/web/compare/html.scm
View file

@ -22,6 +22,7 @@
#:use-module (texinfo) #:use-module (texinfo)
#:use-module (texinfo html) #:use-module (texinfo html)
#:use-module (guix-data-service web query-parameters) #:use-module (guix-data-service web query-parameters)
#:use-module (guix-data-service web html-utils)
#:use-module (guix-data-service web view html) #:use-module (guix-data-service web view html)
#:export (compare #:export (compare
compare/derivation compare/derivation
@ -602,6 +603,7 @@
valid-systems valid-systems
valid-targets valid-targets
valid-build-statuses valid-build-statuses
build-server-urls
derivation-changes) derivation-changes)
(layout (layout
#:body #:body
@ -681,7 +683,7 @@
(th "Version") (th "Version")
(th "System") (th "System")
(th "Target") (th "Target")
(th (@ (class "col-xs-5")) "Derivations") (th (@ (class "col-xs-5")) "Derivations (with build statuses)")
(th ""))) (th "")))
(tbody (tbody
,@(append-map ,@(append-map
@ -704,18 +706,24 @@
(map (map
(match-lambda (match-lambda
((system . target) ((system . target)
(let ((base-derivation-file-name (let* ((base-entry
(assq-ref (find (lambda (details) (find (lambda (details)
(and (string=? (assq-ref details 'system) system) (and (string=? (assq-ref details 'system) system)
(string=? (assq-ref details 'target) target))) (string=? (assq-ref details 'target) target)))
(vector->list base-derivations)) (vector->list base-derivations)))
'derivation-file-name)) (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 (target-derivation-file-name
(assq-ref (find (lambda (details) (assq-ref target-entry 'derivation-file-name))
(and (string=? (assq-ref details 'system) system) (target-builds
(string=? (assq-ref details 'target) target))) (assq-ref target-entry 'builds)))
(vector->list target-derivations))
'derivation-file-name)))
`((td (samp (@ (style "white-space: nowrap;")) `((td (samp (@ (style "white-space: nowrap;"))
,system)) ,system))
(td (samp (@ (style "white-space: nowrap;")) (td (samp (@ (style "white-space: nowrap;"))
@ -725,6 +733,8 @@
(href ,base-derivation-file-name)) (href ,base-derivation-file-name))
(span (@ (class "text-danger glyphicon glyphicon-minus pull-left") (span (@ (class "text-danger glyphicon glyphicon-minus pull-left")
(style "font-size: 1.5em; padding-right: 0.4em;"))) (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))) ,(display-store-item-short base-derivation-file-name)))
'()) '())
,@(if target-derivation-file-name ,@(if target-derivation-file-name
@ -732,7 +742,9 @@
(href ,target-derivation-file-name)) (href ,target-derivation-file-name))
(span (@ (class "text-success glyphicon glyphicon-plus pull-left") (span (@ (class "text-success glyphicon glyphicon-plus pull-left")
(style "font-size: 1.5em; padding-right: 0.4em;"))) (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;")) (td (@ (style "vertical-align: middle;"))
,@(if (and base-derivation-file-name ,@(if (and base-derivation-file-name