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

Take advantage of the new (guix platform) module

Browse source 
This means there's less reliance on the hardcoded lists of systems and targets
and mappings between them.
This commit is contained in:
Christopher Baines 2022-05-26 00:24:55 +01:00
parent 786a5fa041
commit fb8353559f
1 changed files with 70 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -353,9 +353,30 @@ WHERE job_id = $1")
lock time-spent))
result)))))
(define (inferior-guix-systems inf)
(cond
((inferior-eval
'(defined? 'systems
(resolve-module '(guix platform)))
inf)
(remove
(lambda (system)
;; There aren't currently bootstrap binaries for s390x-linux, so this
;; just leads to lots of errors
(string=? system "s390x-linux"))
(inferior-eval
'((@ (guix platform) systems))
inf)))
(else
(inferior-eval
'(@ (guix packages) %supported-systems)
inf))))
(define (all-inferior-system-tests inf store)
(define inferior-%supported-systems
(inferior-eval '(@ (guix packages) %supported-systems) inf))
(define inf-systems
(inferior-guix-systems inf))
(define extract
`(lambda (store)
@ -387,7 +408,7 @@ WHERE job_id = $1")
system
key args)
#f)))
(list ,@inferior-%supported-systems))
(list ,@inf-systems))
(match (system-test-location system-test)
(($ <location> file line column)
(list file
@ -591,11 +612,21 @@ WHERE job_id = $1")
checkers))))
(define (all-inferior-package-derivations store inf packages)
(define inferior-%supported-systems
(inferior-eval '(@ (guix packages) %supported-systems) inf))
(define inf-systems
(inferior-guix-systems inf))
(define cross-derivations
`(("x86_64-linux" . ("arm-linux-gnueabihf"
(define inf-targets
(cond
((inferior-eval
'(defined? 'targets
(resolve-module '(guix platform)))
inf)
(inferior-eval
'((@ (guix platform) targets))
inf))
(else
'("arm-linux-gnueabihf"
"aarch64-linux-gnu"
"mips64el-linux-gnu"
"powerpc-linux-gnu"
@ -605,10 +636,13 @@ WHERE job_id = $1")
"i686-w64-mingw32"
"x86_64-w64-mingw32"))))
(define cross-derivations
`(("x86_64-linux" . ,inf-targets)))
(define supported-system-pairs
(map (lambda (system)
(cons system #f))
inferior-%supported-systems))
inf-systems))
(define supported-system-cross-build-pairs
(append-map
@ -622,13 +656,22 @@ WHERE job_id = $1")
(define (proc packages system-target-pairs)
`(lambda (store)
(define target-system-alist
(if (defined? 'platforms (resolve-module '(guix platform)))
(filter-map
(lambda (platform)
(and
(platform-target platform)
(cons (platform-target platform)
(platform-system platform))))
(platforms))
'(("arm-linux-gnueabihf" . "armhf-linux")
("aarch64-linux-gnu" . "aarch64-linux")
("mips64el-linux-gnu" . "mips64el-linux")
("powerpc-linux-gnu" . "powerpc-linux")
("powerpc64le-linux-gnu" . "powerpc64le-linux")
("riscv64-linux-gnu" . "riscv64-linux")
("i586-pc-gnu" . "i586-gnu")))
("i586-pc-gnu" . "i586-gnu"))))
(define package-transitive-supported-systems-supports-multiple-arguments? #t)
(define (get-supported-systems package system)
@ -749,6 +792,11 @@ WHERE job_id = $1")
'()))))))
(list ,@(map inferior-package-id packages)))))
(inferior-eval
'(when (defined? 'systems (resolve-module '(guix platform)))
(use-modules (guix platform)))
inf)
(append-map
(lambda (system-target-pair)
(format (current-error-port)