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:
parent
7a90afe980
commit
e656b0967b
|
@ -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))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue