aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2019-03-06 22:58:05 +0000
committerChristopher Baines <mail@cbaines.net>2019-03-06 22:58:05 +0000
commite656b0967be7fa9753edd498ce225b74073b87af (patch)
tree2e7aa1276de12f012d5442e317dae425a0a559a2
parent7a90afe980c39efcdb3efcafd031b6b1bdcd1216 (diff)
downloaddata-service-e656b0967be7fa9753edd498ce225b74073b87af.tar
data-service-e656b0967be7fa9753edd498ce225b74073b87af.tar.gz
Include the status of derivations
On the comparison page.
-rw-r--r--guix-data-service/comparison.scm15
-rw-r--r--guix-data-service/model/derivation.scm22
-rw-r--r--guix-data-service/web/controller.scm32
-rw-r--r--guix-data-service/web/view/html.scm16
4 files changed, 63 insertions, 22 deletions
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