06/06: Don't compare across systems in one query

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit 4e7c2bcfbf847d4276c20153b26450a0cd2990af
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Fri Jun 21 12:11:48 2024 +0100

    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