diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index 3fc6215..e3190ad 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -8,6 +8,7 @@ #:export (package-data->package-data-vhashes package-differences-data package-data-vhash->derivations + package-data-vhash->derivations-and-build-status package-data-vhashes->new-packages package-data-vhashes->removed-packages package-data-version-changes @@ -61,6 +62,20 @@ ORDER BY base_packages.name, base_packages.version, target_packages.name, target (select-derivations-by-id conn derivation-ids))) derivation-data)) +(define (package-data-vhash->derivations-and-build-status conn packages-vhash) + (define (vhash->derivation-ids vhash) + (vhash-fold (lambda (key value result) + (cons (third value) + result)) + '() + vhash)) + + (let* ((derivation-ids + (vhash->derivation-ids packages-vhash)) + (derivation-data + (select-derivations-and-build-status-by-id conn derivation-ids))) + derivation-data)) + (define (package-data-vhash->package-name-and-version-vhash vhash) (vhash-fold (lambda (name details result) (vhash-cons (cons name (first details)) diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm index ef39251..a83bf97 100644 --- a/guix-data-service/model/derivation.scm +++ b/guix-data-service/model/derivation.scm @@ -9,6 +9,7 @@ #:use-module (guix-data-service model utils) #:export (select-existing-derivations select-derivations-by-id + select-derivations-and-build-status-by-id insert-into-derivations derivations->derivation-ids)) @@ -289,6 +290,27 @@ (exec-query conn query)) +(define (select-derivations-and-build-status-by-id conn ids) + (define query + (string-append + "SELECT derivations.id, derivations.file_name, latest_build_status.status " + "FROM derivations " + "LEFT OUTER JOIN builds ON derivations.id = builds.derivation_id " + "LEFT OUTER JOIN " + "(SELECT DISTINCT ON (internal_build_id) * " + "FROM build_status " + "ORDER BY internal_build_id, status_fetched_at DESC" + ") AS latest_build_status " + "ON builds.internal_id = latest_build_status.internal_build_id " + "WHERE derivations.id IN " + "(" (string-join (map (lambda (id) + (simple-format #f "'~A'" id)) + ids) + ",") + ");")) + + (exec-query conn query)) + (define (derivations->derivation-ids conn derivations) (define (ensure-input-derivations-exist) (let* ((missing-derivation-file-names (map derivation-file-name diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm index 3299379..145cc01 100644 --- a/guix-data-service/web/controller.scm +++ b/guix-data-service/web/controller.scm @@ -142,27 +142,27 @@ base-revision-id target-revision-id)))) (let ((base-derivations - (package-data-vhash->derivations + (package-data-vhash->derivations-and-build-status conn base-packages-vhash)) (target-derivations - (package-data-vhash->derivations + (package-data-vhash->derivations-and-build-status conn target-packages-vhash))) - (cond - ((eq? content-type 'json) - (render-json - `((base . ((commit . ,base-commit) - (derivations . ,base-derivations))) - (target . ((commit . ,target-commit) - (derivations . ,target-derivations)))))) - (else - (apply render-html - (compare/derivations - base-commit - target-commit - base-derivations - target-derivations))))))) + (cond + ((eq? content-type 'json) + (render-json + `((base . ((commit . ,base-commit) + (derivations . ,base-derivations))) + (target . ((commit . ,target-commit) + (derivations . ,target-derivations)))))) + (else + (apply render-html + (compare/derivations + base-commit + target-commit + base-derivations + target-derivations))))))) (define (render-compare/packages content-type conn diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm index ebf2c20..d998c79 100644 --- a/guix-data-service/web/view/html.scm +++ b/guix-data-service/web/view/html.scm @@ -326,13 +326,15 @@ (@ (class "table")) (thead (tr - (th (@ (class "col-md-12")) "File Name"))) + (th (@ (class "col-md-8")) "File Name") + (th (@ (class "col-md-4")) "Build status"))) (tbody ,@(map (match-lambda - ((id file-name) + ((id file-name build-status) `(tr - (td ,file-name)))) + (td ,file-name) + (td ,build-status)))) base-derivations)))) (div (@ (class "row")) @@ -344,13 +346,15 @@ (@ (class "table")) (thead (tr - (th (@ (class "col-md-12")) "File Name"))) + (th (@ (class "col-md-8")) "File Name") + (th (@ (class "col-md-4")) "Build status"))) (tbody ,@(map (match-lambda - ((id file-name) + ((id file-name build-status) `(tr - (td ,file-name)))) + (td ,file-name) + (td ,build-status)))) target-derivations)))))))) (define (compare/packages base-commit