Don't compare across systems in one query

As the query seems to be super slow, and this allows parallelising it as well.

1 files changed, 29 insertions, 19 deletions

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