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

Support more query parameters on the /builds page

Browse source
This commit is contained in:
Christopher Baines 2021-02-08 21:31:39 +00:00
parent 15d7756ef8
commit f2d98b626d
3 changed files with 146 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

88
guix-data-service/web/build/controller.scm
View file

@ -25,6 +25,7 @@
#:use-module (guix-data-service model build)
#:use-module (guix-data-service model build-status)
#:use-module (guix-data-service model build-server)
#:use-module (guix-data-service model derivation)
#:use-module (guix-data-service web build html)
#:export (build-controller))
@ -66,44 +67,65 @@
(let ((parsed-query-parameters
(parse-query-parameters
request
`((build_status ,parse-build-status #:multi-value)
(build_server ,parse-build-server #:multi-value)))))
`((build_status ,parse-build-status #:multi-value)
(build_server ,parse-build-server #:multi-value)
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target #:default "")
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 50)
(all_results ,parse-checkbox-value)))))
(if (any-invalid-query-parameters? parsed-query-parameters)
(render-html
#:sxml (view-builds parsed-query-parameters
build-status-strings
'()
'()
'()
'()
'()))
(letpar& ((build-server-options
(with-thread-postgresql-connection
(lambda (conn)
(map (match-lambda
((id url lookup-all-derivations
lookup-builds)
(cons url id)))
(select-build-servers conn)))))
(build-stats
(with-thread-postgresql-connection
(lambda (conn)
(select-build-stats
conn
(assq-ref parsed-query-parameters
'build_server)))))
(builds-with-context
(with-thread-postgresql-connection
(lambda (conn)
(select-builds-with-context
conn
(assq-ref parsed-query-parameters
'build_status)
(assq-ref parsed-query-parameters
'build_server)
#:limit 50)))))
(let ((system (assq-ref parsed-query-parameters 'system))
(target (assq-ref parsed-query-parameters 'target)))
(letpar& ((build-server-options
(with-thread-postgresql-connection
(lambda (conn)
(map (match-lambda
((id url lookup-all-derivations
lookup-builds)
(cons url id)))
(select-build-servers conn)))))
(build-stats
(with-thread-postgresql-connection
(lambda (conn)
(select-build-stats
conn
(assq-ref parsed-query-parameters
'build_server)
#:system system
#:target target))))
(builds-with-context
(with-thread-postgresql-connection
(lambda (conn)
(select-builds-with-context
conn
(assq-ref parsed-query-parameters
'build_status)
(assq-ref parsed-query-parameters
'build_server)
#:system system
#:target target
#:limit (assq-ref parsed-query-parameters
'limit_results)))))
(systems
(with-thread-postgresql-connection valid-systems))
(targets
(with-thread-postgresql-connection valid-targets)))
(render-html
#:sxml (view-builds parsed-query-parameters
build-status-strings
build-server-options
build-stats
builds-with-context))))))
(render-html
#:sxml (view-builds parsed-query-parameters
build-status-strings
build-server-options
systems
(valid-targets->options targets)
build-stats
builds-with-context)))))))

21
guix-data-service/web/build/html.scm
View file

@ -25,6 +25,8 @@
(define (view-builds query-parameters
build-status-strings
build-server-options
valid-systems
valid-targets
stats
builds)
(layout
@ -82,6 +84,25 @@
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-targets
#:allow-selecting-multiple-options #f
#:help-text "Only include derivations that are build for this system."
#:font-family "monospace")
,(form-horizontal-control
"Limit results" query-parameters
#:help-text "The maximum number of results to return.")
,(form-horizontal-control
"All results" query-parameters
#:type "checkbox"
#:help-text "Return all results")
(div (@ (class "form-group form-group-lg"))
(div (@ (class "col-sm-offset-2 col-sm-10"))
(button (@ (type "submit")