Rework cross derivations support

Stop using the system values as targets, and remove package derivation entries
where this is the case.

Switch the non-cross derivation case to have a target of "", rather than
matching the system, as this makes more sense, and is more consistent now that
the target values no longer match the system values.

Hardcode some more correct target values, and use these instead. Hopefully
this can be better integrated with Guix in the future.

This commit also includes a migration attempting to shrink some indexes.
This commit is contained in:
Christopher Baines 2020-02-08 11:16:08 +00:00
parent 77beb59495
commit f1989e8758
19 changed files with 202 additions and 21 deletions

View file

@ -384,21 +384,37 @@ WHERE job_id = $1"
(define inferior-%supported-systems
(inferior-eval '(@ (guix packages) %supported-systems) inf))
(define cross-derivations
`(("x86_64-linux" . ("arm-linux-gnueabihf"
"aarch64-linux-gnu"
"powerpc-linux-gnu"
"riscv64-linux-gnu"
"i586-pc-gnu"))))
(define supported-system-pairs
(map (lambda (system)
(cons system system))
(cons system #f))
inferior-%supported-systems))
(define supported-system-cross-build-pairs
(map (lambda (system)
(filter-map (lambda (target)
(and (not (string=? system target))
(cons system target)))
inferior-%supported-systems))
inferior-%supported-systems))
(append-map
(match-lambda
((system . targets)
(list
(map (lambda (target)
(cons system target))
targets))))
cross-derivations))
(define (proc packages system-target-pairs)
`(lambda (store)
(define target-system-alist
'(("arm-linux-gnueabihf" . "armhf-linux")
("aarch64-linux-gnu" . "aarch64-linux")
("powerpc-linux-gnu" . "") ; TODO I don't know?
("riscv64-linux-gnu" . "") ; TODO I don't know?
("i586-pc-gnu" . "i586-gnu")))
(define package-transitive-supported-systems-supports-multiple-arguments? #t)
(define (get-supported-systems package system)
@ -441,11 +457,11 @@ WHERE job_id = $1"
target
(let ((file-name
(derivation-file-name
(if (string=? system target)
(package-derivation store package system)
(if target
(package-cross-derivation store package
target
system)))))
system)
(package-derivation store package system)))))
(add-temp-root store file-name)
file-name))))
(lambda args
@ -470,9 +486,16 @@ WHERE job_id = $1"
package
system
target))
(lset-intersection
string=?
supported-systems
(filter
(match-lambda
(#f #t) ; No target
(target
(let ((system-for-target
(assoc-ref target-system-alist
target)))
(member system-for-target
supported-systems
string=?))))
(list ,@(map cdr system-target-pairs))))
'())))
(delete-duplicates
@ -639,7 +662,7 @@ WHERE job_id = $1"
(list (inferior-package-id->package-database-id
inferior-package-id)
system
target)))
(or target ""))))
inferior-data-4-tuples)))

View file

@ -34,6 +34,7 @@
#:use-module (guix-data-service database)
#:use-module (guix-data-service model utils)
#:export (valid-systems
valid-targets
count-derivations
select-derivation-by-file-name
select-derivation-by-file-name-hash
@ -66,6 +67,14 @@
"mips64el-linux"
"x86_64-linux"))
(define (valid-targets conn)
'("" ;; no target
"arm-linux-gnueabihf"
"aarch64-linux-gnu"
"powerpc-linux-gnu"
"riscv64-linux-gnu"
"i586-pc-gnu"))
(define (count-derivations conn)
(first
(exec-query

View file

@ -257,7 +257,7 @@
`((system ,(parse-build-system conn)
#:default "x86_64-linux")
(target ,(parse-build-system conn)
#:default "x86_64-linux")))))
#:default "")))))
(let* ((system
(assq-ref parsed-query-parameters 'system))
(target
@ -304,5 +304,6 @@
branch-name
package-name
(valid-systems conn)
(valid-targets conn)
build-server-urls
package-derivations)))))))

View file

@ -327,6 +327,7 @@
branch-name
package-name
valid-systems
valid-targets
build-server-urls
derivations-by-revision-range)
(define versions-list
@ -383,7 +384,7 @@
#:help-text "Show derivations with this system.")
,(form-horizontal-control
"Target" query-parameters
#:options valid-systems
#:options valid-targets
#:allow-selecting-multiple-options #f
#:help-text "Show derivations with this target.")
(div (@ (class "form-group form-group-lg"))

View file

@ -172,7 +172,7 @@
request
`((search_query ,identity)
(system ,parse-system #:multi-value)
(target ,parse-system #:multi-value)
(target ,identity #:multi-value)
(maximum_builds ,parse-number)
(minimum_builds ,parse-number)
(after_name ,identity)
@ -201,7 +201,7 @@
(output_consistency ,identity
#:default "any")
(system ,parse-system #:default "x86_64-linux")
(target ,parse-system #:default "x86_64-linux")
(target ,identity)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 10)
@ -242,7 +242,7 @@
`((build_status ,parse-build-status #:multi-value)
(build_server ,(parse-build-server conn) #:multi-value)
(system ,parse-system #:default "x86_64-linux")
(target ,parse-system #:default "x86_64-linux")))))
(target ,identity)))))
(render-revision-builds mime-types
conn
@ -661,6 +661,7 @@
#:sxml (view-revision-derivations commit-hash
query-parameters
(valid-systems conn)
(valid-targets conn)
'()
'()
#f
@ -717,6 +718,7 @@
#:sxml (view-revision-derivations commit-hash
query-parameters
(valid-systems conn)
(valid-targets conn)
derivations
build-server-urls
show-next-page?
@ -748,6 +750,7 @@
'()
'()
'()
'()
#:path-base path-base
#:header-text header-text
#:header-link header-link))))
@ -790,6 +793,7 @@
derivation-outputs
build-server-urls
(valid-systems conn)
(valid-targets conn)
show-next-page?
#:path-base path-base
#:header-text header-text

View file

@ -967,6 +967,7 @@ figure {
(define* (view-revision-derivations commit-hash
query-parameters
valid-systems
valid-targets
derivations
build-server-urls
show-next-page?
@ -1007,7 +1008,7 @@ figure {
#:font-family "monospace")
,(form-horizontal-control
"Target" query-parameters
#:options valid-systems
#:options valid-targets
#:help-text "Only include derivations that are build for this system."
#:font-family "monospace")
,(form-horizontal-control
@ -1096,6 +1097,7 @@ figure {
derivation-outputs
build-server-urls
valid-systems
valid-targets
show-next-page?
#:key (path-base "/revision/")
header-text
@ -1144,7 +1146,7 @@ figure {
#:font-family "monospace")
,(form-horizontal-control
"Target" query-parameters
#:options valid-systems
#:options valid-targets
#:allow-selecting-multiple-options #f
#:help-text "Only include outputs from derivations that are build for this system."
#:font-family "monospace")