cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tweak loading package derivations

Browse source 
Make sure to log any errors, and also use a more efficient approach sending
less data to the inferior.
This commit is contained in:
Christopher Baines 2023-07-17 13:27:21 +01:00
parent 9dec45d2eb
commit ed974ebf3b
1 changed files with 28 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

41
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -721,8 +721,8 @@ WHERE job_id = $1")
targets))) targets)))
cross-derivations)) cross-derivations))
(define (proc packages system-target-pairs) (define proc
`(lambda (store) '(lambda (store system-target-pairs)
(define target-system-alist (define target-system-alist
(if (defined? 'platforms (resolve-module '(guix platform))) (if (defined? 'platforms (resolve-module '(guix platform)))
(filter-map (filter-map
@ -801,9 +801,13 @@ WHERE job_id = $1")
(derivation-system derivation)) (derivation-system derivation))
#f))))) #f)))))
(lambda args (lambda args
;; misc-error #f ~A ~S (No (simple-format
;; cross-compilation for (current-error-port)
;; clojure-build-system yet: "warning: error when computing ~A derivation for system ~A (~A): ~A\n"
(package-name package)
system
(or target "no target")
args)
#f))) #f)))
(append-map (append-map
@ -834,10 +838,10 @@ WHERE job_id = $1")
(member system-for-target (member system-for-target
(package-supported-systems package) (package-supported-systems package)
string=?))))) string=?)))))
(list ,@(map cdr system-target-pairs)))) (map cdr system-target-pairs)))
'()))) '())))
(delete-duplicates (delete-duplicates
(list ,@(map car system-target-pairs)) (map car system-target-pairs)
string=?))) string=?)))
(lambda (key . args) (lambda (key . args)
(if (and (eq? key 'system-error) (if (and (eq? key 'system-error)
@ -858,13 +862,22 @@ WHERE job_id = $1")
key key
args) args)
'())))))) '()))))))
(list ,@(map inferior-package-id packages))))) gds-inferior-package-ids)))
(inferior-eval (inferior-eval
'(when (defined? 'systems (resolve-module '(guix platform))) '(when (defined? 'systems (resolve-module '(guix platform)))
(use-modules (guix platform))) (use-modules (guix platform)))
inf) 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 (append-map
(lambda (system-target-pair) (lambda (system-target-pair)
(format (current-error-port) (format (current-error-port)
@ -913,11 +926,13 @@ WHERE job_id = $1")
(/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf) (/ (inferior-eval '(assoc-ref (gc-stats) 'heap-size) inf)
(expt 2. 20)))) (expt 2. 20))))
(let ((derivations (with-time-logging
(with-time-logging (simple-format #f "getting derivations for ~A" system-target-pair)
(simple-format #f "getting derivations for ~A" system-target-pair) (inferior-eval-with-store
(inferior-eval-with-store inf store (proc packages (list system-target-pair)))))) inf
derivations)) store
`(lambda (store)
(gds-packages-proc store (list (quote ,system-target-pair)))))))
(append supported-system-pairs (append supported-system-pairs
supported-system-cross-build-pairs))) supported-system-cross-build-pairs)))