WIPwip-temp-table-insertion

4 files changed, 109 insertions, 21 deletions

diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm
index cc927d8..ea1f249 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -384,21 +384,37 @@ WHERE job_id = $1"
   (define inferior-%supported-systems
     (inferior-eval '(@ (guix packages) %supported-systems) inf))
 
+  (define cross-derivations
+    `(("x86_64-linux" . ("arm-linux-gnueabihf"
+                         "aarch64-linux-gnu"
+                         "powerpc-linux-gnu"
+                         "riscv64-linux-gnu"
+                         "i586-pc-gnu"))))
+
   (define supported-system-pairs
     (map (lambda (system)
-           (cons system system))
+           (cons system #f))
          inferior-%supported-systems))
 
   (define supported-system-cross-build-pairs
-    (map (lambda (system)
-           (filter-map (lambda (target)
-                         (and (not (string=? system target))
-                              (cons system target)))
-                       inferior-%supported-systems))
-         inferior-%supported-systems))
+    (append-map
+     (match-lambda
+       ((system . targets)
+        (list
+         (map (lambda (target)
+                (cons system target))
+              targets))))
+     cross-derivations))
 
   (define (proc packages system-target-pairs)
     `(lambda (store)
+       (define target-system-alist
+         '(("arm-linux-gnueabihf" . "armhf-linux")
+           ("aarch64-linux-gnu" . "aarch64-linux")
+           ("powerpc-linux-gnu" . "")   ; TODO I don't know?
+           ("riscv64-linux-gnu" . "")   ; TODO I don't know?
+           ("i586-pc-gnu" . "i586-gnu")))
+
        (define package-transitive-supported-systems-supports-multiple-arguments? #t)
 
        (define (get-supported-systems package system)
@@ -441,11 +457,11 @@ WHERE job_id = $1"
                      target
                      (let ((file-name
                             (derivation-file-name
-                             (if (string=? system target)
-                                 (package-derivation store package system)
+                             (if target
                                  (package-cross-derivation store package
                                                            target
-                                                           system)))))
+                                                           system)
+                                 (package-derivation store package system)))))
                        (add-temp-root store file-name)
                        file-name))))
            (lambda args
@@ -470,9 +486,16 @@ WHERE job_id = $1"
                                                                package
                                                                system
                                                                target))
-                          (lset-intersection
-                           string=?
-                           supported-systems
+                          (filter
+                           (match-lambda
+                             (#f #t)  ; No target
+                             (target
+                              (let ((system-for-target
+                                     (assoc-ref target-system-alist
+                                                target)))
+                                (member system-for-target
+                                        supported-systems
+                                        string=?))))
                            (list ,@(map cdr system-target-pairs))))
                          '())))
                  (delete-duplicates
diff --git a/guix-data-service/model/derivation.scm b/guix-data-service/model/derivation.scm
index 033168b..b6f5492 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -66,6 +66,13 @@
     "mips64el-linux"
     "x86_64-linux"))
 
+(define (valid-targets conn)
+  '("arm-linux-gnueabihf"
+    "aarch64-linux-gnu"
+    "powerpc-linux-gnu"
+    "riscv64-linux-gnu"
+    "i586-pc-gnu"))
+
 (define (count-derivations conn)
   (first
    (exec-query
diff --git a/guix-data-service/model/package-metadata.scm b/guix-data-service/model/package-metadata.scm
index 87a5dba..e2166d5 100644
--- a/guix-data-service/model/package-metadata.scm
+++ b/guix-data-service/model/package-metadata.scm
@@ -179,4 +179,7 @@ WHERE packages.id IN (
    ;; you have one package definition which interits from another, and just
    ;; overrides the version and the source, the package_metadata entries for
    ;; both definitions will be the same.
-   #:delete-duplicates? #t))
+   #:delete-duplicates? #t
+   ;; There is so much package metadata that it's worth creating a temporary
+   ;; table
+   #:use-temporary-table? #t))
diff --git a/guix-data-service/model/utils.scm b/guix-data-service/model/utils.scm
index fc6d77c..d9b538b 100644
--- a/guix-data-service/model/utils.scm
+++ b/guix-data-service/model/utils.scm
@@ -120,7 +120,8 @@
           data
           #:key
           sets-of-data?
-          delete-duplicates?)
+          delete-duplicates?
+          use-temporary-table?)
   (define field-strings
     (map symbol->string fields))
 
@@ -177,7 +178,28 @@
            field-strings)
       " AND ")))
 
-  (define (insert-sql missing-data)
+  (define (temp-table-select-query temp-table-name)
+    (string-append
+     "SELECT id, "
+     (string-join (map (lambda (field)
+                         (string-append table-name "." field))
+                       field-strings)
+                  ", ")
+     " FROM " table-name
+     " INNER JOIN " temp-table-name
+     " ON "
+     (string-join
+      (map (lambda (field)
+             (string-append
+              "(" table-name "." field " = " temp-table-name "." field
+              " OR (" table-name "." field " IS NULL AND"
+              " vals." field " IS NULL))"))
+           field-strings)
+      " AND ")))
+
+  (define* (insert-sql missing-data
+                       #:key
+                       (table-name table-name))
     (string-append
      "INSERT INTO " table-name " ("
      (string-join field-strings ", ")
@@ -227,11 +249,44 @@
          data))
 
   (let* ((existing-entries
-          (exec-query->vhash conn
-                             select-query
-                             cdr
-                             (lambda (result)
-                               (string->number (first result)))))
+          (if use-temporary-table?
+              (let ((temp-table-name
+                     (string-append "temp_" table-name))
+                    (data
+                     (if sets-of-data?
+                         (delete-duplicates (concatenate data))
+                         (if delete-duplicates?
+                             (delete-duplicates data)
+                             data))))
+                ;; Create a temporary table to store the data
+                (exec-query
+                 conn
+                 (string-append "CREATE TEMPORARY TABLE "
+                                temp-table-name
+                                " (LIKE "
+                                table-name
+                                " INCLUDING DEFAULTS)"))
+                ;; Populate the temporary table
+                (exec-query conn
+                            (insert-sql data
+                                        #:table-name temp-table-name))
+                ;; Use the temporary table to find the existing values
+                (let ((result
+                       (exec-query->vhash conn
+                                          temp-table-select-query
+                                          cdr
+                                          (lambda (result)
+                                            (string->number (first result))))))
+
+                  (exec-query conn (string-append "DROP TABLE " temp-table-name))
+                  result))
+
+              ;; If not using a temporary table, just do a single SELECT query
+              (exec-query->vhash conn
+                                 select-query
+                                 cdr
+                                 (lambda (result)
+                                   (string->number (first result))))))
          (missing-entries
           (filter (lambda (field-values)
                     (not (vhash-assoc