aboutsummaryrefslogtreecommitdiff
path: root/guix-data-service
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2023-07-17 13:27:21 +0100
committerChristopher Baines <mail@cbaines.net>2023-07-17 13:27:21 +0100
commited974ebf3b9eeb60a6256fb9f2fc654b6e8bd3e2 (patch)
tree3baa46657c585e1007506684cb0400399c223a83 /guix-data-service
parent9dec45d2eb1563c5bc9b9b7631682e9c6c743c3e (diff)
downloaddata-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.scm41
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)))