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

Allow filtering the revision builds page by system

Browse source
This commit is contained in:
Christopher Baines 2019-12-22 14:27:59 +00:00
parent e4a7f221c9
commit 14b7993636
3 changed files with 74 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

37
guix-data-service/model/build.scm
View file

@ -13,7 +13,9 @@
insert-build
ensure-build-exists))
(define* (select-build-stats conn build-servers #:key revision-commit)
(define* (select-build-stats conn build-servers
#:key revision-commit
system target)
(define criteria
`(,@(if revision-commit
;; Ignore cross built derivations, as I'm not aware of a build server
@ -30,6 +32,12 @@
'())
,@(if revision-commit
'("guix_revisions.commit = $1")
'())
,@(if system
'("package_derivations.system = $2")
'())
,@(if target
'("package_derivations.target = $3")
'())))
(define query
@ -85,10 +93,17 @@ ORDER BY status"))
query
`(,@(if revision-commit
(list revision-commit)
'())
,@(if system
(list system)
'())
,@(if target
(list target)
'()))))))
(define* (select-builds-with-context conn build-statuses build-server-ids
#:key revision-commit)
#:key revision-commit
system target)
(define where-conditions
(filter
string?
@ -106,7 +121,11 @@ ORDER BY status"))
", ")
")"))
(when revision-commit
"guix_revisions.commit = $1"))))
"guix_revisions.commit = $1")
(when system
"package_derivations.system = $2")
(when target
"package_derivations.target = $3"))))
(define query
(string-append
@ -146,9 +165,15 @@ LIMIT 100"))
(exec-query conn
query
(if revision-commit
(list revision-commit)
'())))
`(,@(if revision-commit
(list revision-commit)
'())
,@(if system
(list system)
'())
,@(if target
(list target)
'()))))
(define (select-builds-with-context-by-derivation-file-name
conn derivation-file-name)

50
guix-data-service/web/revision/controller.scm
View file

@ -234,7 +234,9 @@
(parse-query-parameters
request
`((build_status ,parse-build-status #:multi-value)
(build_server ,(parse-build-server conn) #:multi-value)))))
(build_server ,(parse-build-server conn) #:multi-value)
(system ,parse-system #:default "x86_64-linux")
(target ,parse-system #:default "x86_64-linux")))))
(render-revision-builds mime-types
conn
@ -754,28 +756,36 @@
(render-html
#:sxml (view-revision-builds query-parameters
build-status-strings
(valid-systems conn)
'()
'()
'()))
(render-html
#:sxml (view-revision-builds query-parameters
build-status-strings
(map (match-lambda
((id url lookup-all-derivations)
(cons url id)))
(select-build-servers conn))
(select-build-stats
conn
(assq-ref query-parameters
'build_server)
#:revision-commit commit-hash)
(select-builds-with-context
conn
(assq-ref query-parameters
'build_status)
(assq-ref query-parameters
'build_server)
#:revision-commit commit-hash)))))
(let ((system (assq-ref query-parameters 'system))
(target (assq-ref query-parameters 'target)))
(render-html
#:sxml (view-revision-builds query-parameters
build-status-strings
(valid-systems conn)
(map (match-lambda
((id url lookup-all-derivations)
(cons url id)))
(select-build-servers conn))
(select-build-stats
conn
(assq-ref query-parameters
'build_server)
#:revision-commit commit-hash
#:system system
#:target target)
(select-builds-with-context
conn
(assq-ref query-parameters
'build_status)
(assq-ref query-parameters
'build_server)
#:revision-commit commit-hash
#:system system
#:target target))))))
(define* (render-revision-lint-warnings mime-types
conn

13
guix-data-service/web/revision/html.scm
View file

@ -1149,6 +1149,7 @@ figure {
(define (view-revision-builds query-parameters
build-status-strings
valid-systems
build-server-options
stats
builds)
@ -1210,6 +1211,18 @@ figure {
query-parameters
#:options build-server-options
#:help-text "Return builds from these build servers.")
,(form-horizontal-control
"System" query-parameters
#:options valid-systems
#:allow-selecting-multiple-options #f
#:help-text "Only include derivations for this system."
#:font-family "monospace")
,(form-horizontal-control
"Target" query-parameters
#:options valid-systems
#:allow-selecting-multiple-options #f
#:help-text "Only include derivations that are build for this system."
#:font-family "monospace")
(div (@ (class "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit")