diff options
| author | Christopher Baines <mail@cbaines.net> | 2019-12-01 07:56:07 +0000 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2019-12-01 07:56:07 +0000 |
| commit | 414636535033c288f061f109b7c28d2ebbc4756d (patch) | |
| tree | c79d3287e4550f11e29205e01d15a3838fea7a26 | |
| parent | fea4dc9385f6f42e7b89f1fafe1a8189f62af9eb (diff) | |
| download | data-service-wip-fix-foreign.tar data-service-wip-fix-foreign.tar.gz | |
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 60 |
1 files changed, 43 insertions, 17 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 86c3a78..7a87e51 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -333,29 +333,55 @@ WHERE job_id = $1" (define (proc packages system-target-pairs) `(lambda (store) + (define package-transitive-supported-systems-supports-multiple-arguments? #t) + (append-map (lambda (inferior-package-id) (let ((package (hashv-ref %package-table inferior-package-id))) (catch #t (lambda () - (let ((supported-systems - (catch - #t - (lambda () - (package-transitive-supported-systems package)) - (lambda (key . args) - (simple-format - (current-error-port) - "error: while processing ~A, unable to compute transitive supported systems\n" - (package-name package)) - (simple-format - (current-error-port) - "error ~A: ~A\n" key args) - #f)))) - (if supported-systems - (append-map - (lambda (system) + (append-map + (lambda (system) + (let ((supported-systems + (or (and + package-transitive-supported-systems-supports-multiple-arguments? + (catch + 'wrong-number-of-args + (lambda () + (and=> (package-transitive-supported-systems package system) + (lambda (systems) + (if (member system systems) + systems) + (lambda (key . args) + ;; Older Guix revisions don't support two + ;; arguments to + ;; package-transitive-supported-systems + (simple-format + (current-error-port) + "info: package-transitive-supported-systems doesn't support two arguments, falling back to one\n") + (set! package-transitive-supported-systems-supports-multiple-arguments? #f) + #f)))))) + (catch + #t + (lambda () + (and=> (package-transitive-supported-systems package) + (lambda (systems) + ;; Skip this system unless it's in + ;; the list of supported systems + (if (member system systems) + systems + #f)))) + (lambda (key . args) + (simple-format + (current-error-port) + "error: while processing ~A, unable to compute transitive supported systems\n" + (package-name package)) + (simple-format + (current-error-port) + "error ~A: ~A\n" key args) + #f))))) + (if supported-systems (filter-map (lambda (target) (catch |