[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: Include a "Build change" filter on the package derivations page
|
From: |
Christopher Baines |
|
Subject: |
04/04: Include a "Build change" filter on the package derivations page |
|
Date: |
Thu, 19 Nov 2020 16:09:03 -0500 (EST) |
cbaines pushed a commit to branch master
in repository data-service.
commit ce73e4448db10027749df19e005c42c882ef0630
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Thu Nov 19 21:02:47 2020 +0000
Include a "Build change" filter on the package derivations page
This helps determine what things a change broke or fixed for example.
---
guix-data-service/web/compare/controller.scm | 45 +++++++++++++++++++---------
guix-data-service/web/compare/html.scm | 33 ++++++++++++++++++++
2 files changed, 64 insertions(+), 14 deletions(-)
diff --git a/guix-data-service/web/compare/controller.scm
b/guix-data-service/web/compare/controller.scm
index 2ef8204..b41090c 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -69,6 +69,17 @@
(make-invalid-query-parameter
file-name "unknown derivation")))
+(define (parse-build-change val)
+ (or (if (member val '("broken" "fixed"
+ "still-working"
+ "still-failing"
+ "unknown"))
+ val
+ #f)
+ (make-invalid-query-parameter
+ val
+ "unknown build change value")))
+
(define (compare-controller request
method-and-path-components
mime-types
@@ -110,7 +121,8 @@
(target_commit ,parse-commit #:required)
(system ,parse-system #:multi-value)
(target ,parse-target #:multi-value)
- (build_status ,parse-build-status #:multi-value)))))
+ (build_status ,parse-build-status #:multi-value)
+ (build_change ,parse-build-change)))))
(render-compare/package-derivations mime-types
parsed-query-parameters)))
(('GET "compare-by-datetime" "package-derivations")
@@ -124,7 +136,8 @@
(target_datetime ,parse-datetime #:required)
(system ,parse-system #:multi-value)
(target ,parse-target #:multi-value)
- (build_status ,parse-build-status #:multi-value)))
+ (build_status ,parse-build-status #:multi-value)
+ (build-change ,parse-build-change)))
'((base_commit base_datetime)
(target_commit target_datetime)))))
(render-compare-by-datetime/package-derivations mime-types
@@ -534,7 +547,10 @@
(let ((base-commit (assq-ref query-parameters 'base_commit))
(target-commit (assq-ref query-parameters 'target_commit))
(systems (assq-ref query-parameters 'system))
- (targets (assq-ref query-parameters 'target)))
+ (targets (assq-ref query-parameters 'target))
+ (build-change (and=>
+ (assq-ref query-parameters 'build_change)
+ string->symbol)))
(letpar& ((data
(with-thread-postgresql-connection
(lambda (conn)
@@ -543,7 +559,8 @@
(commit->revision-id conn base-commit)
(commit->revision-id conn target-commit)
#:systems systems
- #:targets targets))))
+ #:targets targets
+ #:build-change build-change))))
(build-server-urls
(with-thread-postgresql-connection
select-build-server-urls-by-id)))
@@ -561,8 +578,7 @@
mime-types)
((application/json)
(render-json
- derivation-changes
- #:extra-headers http-headers-for-unchanging-content))
+ derivation-changes))
(else
(letpar& ((systems
(with-thread-postgresql-connection
@@ -577,8 +593,7 @@
(valid-targets->options targets)
build-status-strings
build-server-urls
- derivation-changes)
- #:extra-headers
http-headers-for-unchanging-content)))))))))))
+ derivation-changes))))))))))))
(define (render-compare-by-datetime/package-derivations mime-types
query-parameters)
@@ -605,7 +620,10 @@
(target-branch (assq-ref query-parameters 'target_branch))
(target-datetime (assq-ref query-parameters 'target_datetime))
(systems (assq-ref query-parameters 'system))
- (targets (assq-ref query-parameters 'target)))
+ (targets (assq-ref query-parameters 'target))
+ (build-change (and=>
+ (assq-ref query-parameters 'build_change)
+ string->symbol)))
(letpar&
((base-revision-details
(with-thread-postgresql-connection
@@ -628,7 +646,8 @@
(first base-revision-details)
(first target-revision-details)
#:systems systems
- #:targets targets)))))
+ #:targets targets
+ #:build-change build-change)))))
(let ((names-and-versions
(package-derivation-data->names-and-versions data)))
(let-values
@@ -643,8 +662,7 @@
mime-types)
((application/json)
(render-json
- derivation-changes
- #:extra-headers http-headers-for-unchanging-content))
+ derivation-changes))
(else
(render-html
#:sxml (compare-by-datetime/package-derivations
@@ -654,8 +672,7 @@
build-status-strings
base-revision-details
target-revision-details
- derivation-changes)
- #:extra-headers
http-headers-for-unchanging-content)))))))))))
+ derivation-changes))))))))))))
(define (render-compare/packages mime-types
query-parameters)
diff --git a/guix-data-service/web/compare/html.scm
b/guix-data-service/web/compare/html.scm
index f4105c1..7434dfd 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -652,6 +652,39 @@
#:options valid-targets
#:help-text "Only include derivations that are build for this
system."
#:font-family "monospace")
+ ,(form-horizontal-control
+ "Build change" query-parameters
+ #:options '(("(none specified)" . "")
+ ("Broken" . "broken")
+ ("Fixed" . "fixed")
+ ("Still working" . "still-working")
+ ("Still failing" . "still-failing")
+ ("Unknown" . "unknown"))
+ #:help-text '("Filter by the changes to the builds:"
+ (dl
+ (@ (class "dl-horizontal"))
+ (dt "Broken")
+ (dd
+ "There was a successful build against the base
+derivation, but no successful build for the target derivation, and there's at
+least one failed build.")
+ (dt "Fixed")
+ (dd
+ "No successful build for the base derivation and
+at least one failed build, plus at least one successful build for the target
+derivation")
+ (dt "Still working")
+ (dd
+ "At least one successful build for both the base
+and target derivations")
+ (dt "Still broken")
+ (dd
+ "No successful builds and at least one failed
builds for both the base and target derivations")
+ (dt "Unknown")
+ (dd
+ "No base and target derivation to compare, or not
+enought builds to determine a change")))
+ #:allow-selecting-multiple-options #f)
(div (@ (class "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit")