2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00

Include the status of derivations

On the comparison page.
This commit is contained in:
Christopher Baines 2019-03-06 22:58:05 +00:00
parent 7a90afe980
commit e656b0967b
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
4 changed files with 63 additions and 22 deletions

View file

@ -8,6 +8,7 @@
#:export (package-data->package-data-vhashes #:export (package-data->package-data-vhashes
package-differences-data package-differences-data
package-data-vhash->derivations package-data-vhash->derivations
package-data-vhash->derivations-and-build-status
package-data-vhashes->new-packages package-data-vhashes->new-packages
package-data-vhashes->removed-packages package-data-vhashes->removed-packages
package-data-version-changes 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))) (select-derivations-by-id conn derivation-ids)))
derivation-data)) 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) (define (package-data-vhash->package-name-and-version-vhash vhash)
(vhash-fold (lambda (name details result) (vhash-fold (lambda (name details result)
(vhash-cons (cons name (first details)) (vhash-cons (cons name (first details))

View file

@ -9,6 +9,7 @@
#:use-module (guix-data-service model utils) #:use-module (guix-data-service model utils)
#:export (select-existing-derivations #:export (select-existing-derivations
select-derivations-by-id select-derivations-by-id
select-derivations-and-build-status-by-id
insert-into-derivations insert-into-derivations
derivations->derivation-ids)) derivations->derivation-ids))
@ -289,6 +290,27 @@
(exec-query conn query)) (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 (derivations->derivation-ids conn derivations)
(define (ensure-input-derivations-exist) (define (ensure-input-derivations-exist)
(let* ((missing-derivation-file-names (map derivation-file-name (let* ((missing-derivation-file-names (map derivation-file-name

View file

@ -142,27 +142,27 @@
base-revision-id base-revision-id
target-revision-id)))) target-revision-id))))
(let ((base-derivations (let ((base-derivations
(package-data-vhash->derivations (package-data-vhash->derivations-and-build-status
conn conn
base-packages-vhash)) base-packages-vhash))
(target-derivations (target-derivations
(package-data-vhash->derivations (package-data-vhash->derivations-and-build-status
conn conn
target-packages-vhash))) target-packages-vhash)))
(cond (cond
((eq? content-type 'json) ((eq? content-type 'json)
(render-json (render-json
`((base . ((commit . ,base-commit) `((base . ((commit . ,base-commit)
(derivations . ,base-derivations))) (derivations . ,base-derivations)))
(target . ((commit . ,target-commit) (target . ((commit . ,target-commit)
(derivations . ,target-derivations)))))) (derivations . ,target-derivations))))))
(else (else
(apply render-html (apply render-html
(compare/derivations (compare/derivations
base-commit base-commit
target-commit target-commit
base-derivations base-derivations
target-derivations))))))) target-derivations)))))))
(define (render-compare/packages content-type (define (render-compare/packages content-type
conn conn

View file

@ -326,13 +326,15 @@
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
(th (@ (class "col-md-12")) "File Name"))) (th (@ (class "col-md-8")) "File Name")
(th (@ (class "col-md-4")) "Build status")))
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
((id file-name) ((id file-name build-status)
`(tr `(tr
(td ,file-name)))) (td ,file-name)
(td ,build-status))))
base-derivations)))) base-derivations))))
(div (div
(@ (class "row")) (@ (class "row"))
@ -344,13 +346,15 @@
(@ (class "table")) (@ (class "table"))
(thead (thead
(tr (tr
(th (@ (class "col-md-12")) "File Name"))) (th (@ (class "col-md-8")) "File Name")
(th (@ (class "col-md-4")) "Build status")))
(tbody (tbody
,@(map ,@(map
(match-lambda (match-lambda
((id file-name) ((id file-name build-status)
`(tr `(tr
(td ,file-name)))) (td ,file-name)
(td ,build-status))))
target-derivations)))))))) target-derivations))))))))
(define (compare/packages base-commit (define (compare/packages base-commit