cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Don't show all results on the compare package derivation page

Browse source 
By default. For comparisons involving lots of changed derivations, the page
can take too long to render.
This commit is contained in:
Christopher Baines 2020-11-20 19:33:16 +00:00
parent 7b92a6a5b3
commit 65507aaac1
2 changed files with 47 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

50
guix-data-service/web/compare/controller.scm
View file

@ -115,14 +115,22 @@
parsed-query-parameters))) parsed-query-parameters)))
(('GET "compare" "package-derivations") (('GET "compare" "package-derivations")
(let* ((parsed-query-parameters (let* ((parsed-query-parameters
(parse-query-parameters (guard-against-mutually-exclusive-query-parameters
request (parse-query-parameters
`((base_commit ,parse-commit #:required) request
(target_commit ,parse-commit #:required) `((base_commit ,parse-commit #:required)
(system ,parse-system #:multi-value) (target_commit ,parse-commit #:required)
(target ,parse-target #:multi-value) (system ,parse-system #:multi-value)
(build_status ,parse-build-status #:multi-value) (target ,parse-target #:multi-value)
(build_change ,parse-build-change))))) (build_status ,parse-build-status #:multi-value)
(build_change ,parse-build-change)
(after_name ,identity)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 40)
(all_results ,parse-checkbox-value)))
'((limit_results all_results)))))
(render-compare/package-derivations mime-types (render-compare/package-derivations mime-types
parsed-query-parameters))) parsed-query-parameters)))
(('GET "compare-by-datetime" "package-derivations") (('GET "compare-by-datetime" "package-derivations")
@ -137,9 +145,15 @@
(system ,parse-system #:multi-value) (system ,parse-system #:multi-value)
(target ,parse-target #: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))) (build-change ,parse-build-change)
(after_name ,identity)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 40)
(all_results ,parse-checkbox-value)))
'((base_commit base_datetime) '((base_commit base_datetime)
(target_commit target_datetime))))) (target_commit target_datetime)
(limit_results all_results)))))
(render-compare-by-datetime/package-derivations mime-types (render-compare-by-datetime/package-derivations mime-types
parsed-query-parameters))) parsed-query-parameters)))
(('GET "compare" "packages") (('GET "compare" "packages")
@ -550,7 +564,9 @@
(targets (assq-ref query-parameters 'target)) (targets (assq-ref query-parameters 'target))
(build-change (and=> (build-change (and=>
(assq-ref query-parameters 'build_change) (assq-ref query-parameters 'build_change)
string->symbol))) string->symbol))
(after-name (assq-ref query-parameters 'after_name))
(limit-results (assq-ref query-parameters 'limit_results)))
(letpar& ((data (letpar& ((data
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn) (lambda (conn)
@ -560,7 +576,9 @@
(commit->revision-id conn target-commit) (commit->revision-id conn target-commit)
#:systems systems #:systems systems
#:targets targets #:targets targets
#:build-change build-change)))) #:build-change build-change
#:after-name after-name
#:limit-results limit-results))))
(build-server-urls (build-server-urls
(with-thread-postgresql-connection (with-thread-postgresql-connection
select-build-server-urls-by-id))) select-build-server-urls-by-id)))
@ -623,7 +641,9 @@
(targets (assq-ref query-parameters 'target)) (targets (assq-ref query-parameters 'target))
(build-change (and=> (build-change (and=>
(assq-ref query-parameters 'build_change) (assq-ref query-parameters 'build_change)
string->symbol))) string->symbol))
(after-name (assq-ref query-parameters 'after_name))
(limit-results (assq-ref query-parameters 'limit_results)))
(letpar& (letpar&
((base-revision-details ((base-revision-details
(with-thread-postgresql-connection (with-thread-postgresql-connection
@ -647,7 +667,9 @@
(first target-revision-details) (first target-revision-details)
#:systems systems #:systems systems
#:targets targets #:targets targets
#:build-change build-change))))) #:build-change build-change
#:after-name after-name
#:limit-results limit-results)))))
(let ((names-and-versions (let ((names-and-versions
(package-derivation-data->names-and-versions data))) (package-derivation-data->names-and-versions data)))
(let-values (let-values

11
guix-data-service/web/compare/html.scm
View file

@ -685,6 +685,17 @@ and target derivations")
"No base and target derivation to compare, or not "No base and target derivation to compare, or not
enough builds to determine a change"))) enough builds to determine a change")))
#:allow-selecting-multiple-options #f) #:allow-selecting-multiple-options #f)
,(form-horizontal-control
"After name" query-parameters
#:help-text
"List packages that are alphabetically after the given name.")
,(form-horizontal-control
"Limit results" query-parameters
#:help-text "The maximum number of results to return.")
,(form-horizontal-control
"All results" query-parameters
#:type "checkbox"
#:help-text "Return all results.")
(div (@ (class "form-group form-group-lg")) (div (@ (class "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10")) (div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit") (button (@ (type "submit")