diff options
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 49 | ||||
| -rw-r--r-- | guix-data-service/model/derivation.scm | 7 | ||||
| -rw-r--r-- | guix-data-service/model/package-metadata.scm | 5 | ||||
| -rw-r--r-- | guix-data-service/model/utils.scm | 69 |
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 |