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
|
||||
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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue