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

Change how package supported systems are handled

Browse source 
This code is a bit tricky, since it should be compatible with old and new guix
revisions. I think these changes stop computing package derivations for
invalid systems, while hopefully not breaking anything.
This commit is contained in:
Christopher Baines 2022-02-18 12:21:08 +00:00
parent 4a1088c216
commit 17167ef3e4
1 changed files with 7 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -588,7 +588,6 @@ WHERE job_id = $1")
("riscv64-linux-gnu" . "") ; TODO I don't know?
("i586-pc-gnu" . "i586-gnu")))
;; TODO Currently unused
(define package-transitive-supported-systems-supports-multiple-arguments? #t)
(define (get-supported-systems package system)
(or (and package-transitive-supported-systems-supports-multiple-arguments?
@ -602,17 +601,17 @@ WHERE job_id = $1")
;; package-transitive-supported-systems
(simple-format
(current-error-port)
"info: package-transitive-supported-systems doesn't support two arguments, falling back to one\n")
"info: package-transitive-supported-systems doesn't support two arguments, falling back to package-supported-systems\n")
(set! package-transitive-supported-systems-supports-multiple-arguments? #f)
#f)))
(catch
#t
(lambda ()
(package-transitive-supported-systems package))
(package-supported-systems package))
(lambda (key . args)
(simple-format
(current-error-port)
"error: while processing ~A, unable to compute transitive supported systems\n"
"error: while processing ~A, unable to compute supported systems\n"
(package-name package))
(simple-format
(current-error-port)
@ -662,8 +661,9 @@ WHERE job_id = $1")
(lambda ()
(append-map
(lambda (system)
(let ((supported-systems (package-supported-systems package)))
(if supported-systems
(let ((supported-systems (get-supported-systems package system)))
(if (and supported-systems
(member system supported-systems))
(filter-map
(lambda (target)
(derivations-for-system-and-target inferior-package-id
@ -678,7 +678,7 @@ WHERE job_id = $1")
(assoc-ref target-system-alist
target)))
(member system-for-target
supported-systems
(package-supported-systems package)
string=?))))
(list ,@(map cdr system-target-pairs))))
'())))