diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-07-17 13:27:21 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-07-17 13:27:21 +0100 |
| commit | ed974ebf3b9eeb60a6256fb9f2fc654b6e8bd3e2 (patch) | |
| tree | 3baa46657c585e1007506684cb0400399c223a83 /guix-data-service | |
| parent | 9dec45d2eb1563c5bc9b9b7631682e9c6c743c3e (diff) | |
| download | data-service-ed974ebf3b9eeb60a6256fb9f2fc654b6e8bd3e2.tar data-service-ed974ebf3b9eeb60a6256fb9f2fc654b6e8bd3e2.tar.gz | |
Tweak loading package derivations
Make sure to log any errors, and also use a more efficient approach sending
less data to the inferior.
Diffstat (limited to 'guix-data-service')
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 41 |
1 files changed, 28 insertions, 13 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index c9408f5..6f61bf4 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -721,8 +721,8 @@ WHERE job_id = $1") targets))) cross-derivations)) - (define (proc packages system-target-pairs) - `(lambda (store) + (define proc + '(lambda (store system-target-pairs) (define target-system-alist (if (defined? 'platforms (resolve-module '(guix platform))) (filter-map @@ -801,9 +801,13 @@ WHERE job_id = $1") (derivation-system derivation)) #f))))) (lambda args - ;; misc-error #f ~A ~S (No - ;; cross-compilation for - ;; clojure-build-system yet: + (simple-format + (current-error-port) + "warning: error when computing ~A derivation for system ~A (~A): ~A\n" + (package-name package) + system + (or target "no target") + args) #f))) (append-map @@ -834,10 +838,10 @@ WHERE job_id = $1") (member system-for-target (package-supported-systems package) string=?))))) - (list ,@(map cdr system-target-pairs)))) + (map cdr system-target-pairs))) '()))) (delete-duplicates - (list ,@(map car system-target-pairs)) + (map car system-target-pairs) string=?))) (lambda (key . args) (if (and (eq? key 'system-error) @@ -858,13 +862,22 @@ WHERE job_id = $1") key args) '())))))) - (list ,@(map inferior-package-id packages))))) + gds-inferior-package-ids))) (inferior-eval '(when (defined? 'systems (resolve-module '(guix platform))) (use-modules (guix platform))) inf) + (inferior-eval + `(define gds-inferior-package-ids + (list ,@(map inferior-package-id packages))) + inf) + + (inferior-eval + `(define gds-packages-proc ,proc) + inf) + (append-map (lambda (system-target-pair) (format (current-error-port) @@ -913,11 +926,13 @@ WHERE job_id = $1") (/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf) (expt 2. 20)))) - (let ((derivations - (with-time-logging - (simple-format #f "getting derivations for ~A" system-target-pair) - (inferior-eval-with-store inf store (proc packages (list system-target-pair)))))) - derivations)) + (with-time-logging + (simple-format #f "getting derivations for ~A" system-target-pair) + (inferior-eval-with-store + inf + store + `(lambda (store) + (gds-packages-proc store (list (quote ,system-target-pair))))))) (append supported-system-pairs supported-system-cross-build-pairs))) |