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

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

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

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

@ -234,7 +234,9 @@
(parse-query-parameters (parse-query-parameters
request request
`((build_status ,parse-build-status #:multi-value) `((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 (render-revision-builds mime-types
conn conn
@ -754,12 +756,16 @@
(render-html (render-html
#:sxml (view-revision-builds query-parameters #:sxml (view-revision-builds query-parameters
build-status-strings build-status-strings
(valid-systems conn)
'() '()
'() '()
'())) '()))
(let ((system (assq-ref query-parameters 'system))
(target (assq-ref query-parameters 'target)))
(render-html (render-html
#:sxml (view-revision-builds query-parameters #:sxml (view-revision-builds query-parameters
build-status-strings build-status-strings
(valid-systems conn)
(map (match-lambda (map (match-lambda
((id url lookup-all-derivations) ((id url lookup-all-derivations)
(cons url id))) (cons url id)))
@ -768,14 +774,18 @@
conn conn
(assq-ref query-parameters (assq-ref query-parameters
'build_server) 'build_server)
#:revision-commit commit-hash) #:revision-commit commit-hash
#:system system
#:target target)
(select-builds-with-context (select-builds-with-context
conn conn
(assq-ref query-parameters (assq-ref query-parameters
'build_status) 'build_status)
(assq-ref query-parameters (assq-ref query-parameters
'build_server) 'build_server)
#:revision-commit commit-hash))))) #:revision-commit commit-hash
#:system system
#:target target))))))
(define* (render-revision-lint-warnings mime-types (define* (render-revision-lint-warnings mime-types
conn conn

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

@ -1149,6 +1149,7 @@ figure {
(define (view-revision-builds query-parameters (define (view-revision-builds query-parameters
build-status-strings build-status-strings
valid-systems
build-server-options build-server-options
stats stats
builds) builds)
@ -1210,6 +1211,18 @@ figure {
query-parameters query-parameters
#:options build-server-options #:options build-server-options
#:help-text "Return builds from these build servers.") #: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 "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10")) (div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit") (button (@ (type "submit")