From 4e7c2bcfbf847d4276c20153b26450a0cd2990af Mon Sep 17 00:00:00 2001 From: Christopher Baines Date: Fri, 21 Jun 2024 12:11:48 +0100 Subject: [PATCH] Don't compare across systems in one query As the query seems to be super slow, and this allows parallelising it as well. --- guix-data-service/comparison.scm | 13 ++---- guix-data-service/web/compare/controller.scm | 48 ++++++++++++-------- 2 files changed, 32 insertions(+), 29 deletions(-) diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm index 10a5ce7..9a251fe 100644 --- a/guix-data-service/comparison.scm +++ b/guix-data-service/comparison.scm @@ -255,7 +255,7 @@ GROUP BY derivation_source_files.store_path")) base_guix_revision_id target_guix_revision_id #:key - (systems #f) + (system #f) (targets #f) (include-builds? #t) (exclude-unchanged-outputs? #t) @@ -267,15 +267,8 @@ GROUP BY derivation_source_files.store_path")) after-name) (define extra-constraints (string-append - (if systems - (string-append - " AND systems.system IN (" - (string-join (map - (lambda (s) - (string-append "'" s "'")) - systems) - ", ") - ")") + (if system + (string-append " AND systems.system = '" system "'") "") (if targets (string-append diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm index ebbf6df..242760b 100644 --- a/guix-data-service/web/compare/controller.scm +++ b/guix-data-service/web/compare/controller.scm @@ -684,27 +684,33 @@ (let ((base-commit (assq-ref query-parameters 'base_commit)) (target-commit (assq-ref query-parameters 'target_commit)) - (systems (assq-ref query-parameters 'system)) + (systems (or (assq-ref query-parameters 'system) + (call-with-resource-from-pool (connection-pool) + list-systems))) (targets (assq-ref query-parameters 'target)) (build-change (and=> (assq-ref query-parameters 'build_change) string->symbol)) (after-name (assq-ref query-parameters 'after_name)) (limit-results (assq-ref query-parameters 'limit_results))) - (letpar& ((data + (let ((data + (concatenate! + (par-map& + (lambda (system) (with-resource-from-pool (connection-pool) conn (package-derivation-differences-data conn (commit->revision-id conn base-commit) (commit->revision-id conn target-commit) - #:systems systems + #:system system #:targets targets #:build-change build-change #:after-name after-name #:limit-results limit-results))) - (build-server-urls - (call-with-resource-from-pool (connection-pool) - select-build-server-urls-by-id))) + systems))) + (build-server-urls + (call-with-resource-from-pool (connection-pool) + select-build-server-urls-by-id))) (let ((names-and-versions (package-derivation-data->names-and-versions data))) (let-values @@ -771,7 +777,9 @@ (base-datetime (assq-ref query-parameters 'base_datetime)) (target-branch (assq-ref query-parameters 'target_branch)) (target-datetime (assq-ref query-parameters 'target_datetime)) - (systems (assq-ref query-parameters 'system)) + (systems (or (assq-ref query-parameters 'system) + (call-with-resource-from-pool (connection-pool) + list-systems))) (targets (assq-ref query-parameters 'target)) (build-change (and=> (assq-ref query-parameters 'build_change) @@ -789,18 +797,20 @@ (select-guix-revision-for-branch-and-datetime conn target-branch target-datetime)))) - (letpar& - ((data - (with-resource-from-pool (connection-pool) conn - (package-derivation-differences-data - conn - (first base-revision-details) - (first target-revision-details) - #:systems systems - #:targets targets - #:build-change build-change - #:after-name after-name - #:limit-results limit-results)))) + (let ((data + (par-map& + (lambda (system) + (with-resource-from-pool (connection-pool) conn + (package-derivation-differences-data + conn + (first base-revision-details) + (first target-revision-details) + #:system system + #:targets targets + #:build-change build-change + #:after-name after-name + #:limit-results limit-results))) + systems))) (let ((names-and-versions (package-derivation-data->names-and-versions data))) (let-values