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

Support controlling the fields returned for package derivations

Browse source 
Mostly so that the builds can be avoided when querying for all the
derivations, as that's slow.
This commit is contained in:
Christopher Baines 2020-04-24 10:17:12 +01:00
parent 6fb3892712
commit 68420b1085
3 changed files with 79 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

34
guix-data-service/model/derivation.scm
View file

@ -181,7 +181,9 @@ ORDER BY derivations.system DESC,
(filter (lambda (build)
(assoc-ref build "status"))
(vector->list
(json-string->scm builds-json))))))
(json-string->scm builds-json)))))
((file_name system target)
(list file_name system target)))
(exec-query conn
query
(list revision-commit-hash name version))))
@ -194,7 +196,8 @@ ORDER BY derivations.system DESC,
minimum-builds
maximum-builds
limit-results
after-name)
after-name
(include-builds? #t))
(define criteria
(string-join
`(,@(filter-map
@ -243,7 +246,9 @@ ORDER BY derivations.system DESC,
"
SELECT derivations.file_name,
derivations.system,
package_derivations.target,
package_derivations.target"
(if include-builds?
",
(
SELECT JSON_AGG(
json_build_object(
@ -264,7 +269,9 @@ SELECT derivations.file_name,
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
derivations_by_output_details_set.derivation_output_details_set_id
) AS builds
) AS builds"
"")
"
FROM derivations
INNER JOIN derivations_by_output_details_set
ON derivations.id = derivations_by_output_details_set.derivation_id
@ -299,7 +306,9 @@ ORDER BY derivations.file_name
target
(if (string-null? builds)
#()
(json-string->scm builds)))))
(json-string->scm builds))))
((file_name system target)
(list file_name system target)))
(exec-query conn
query
`(,commit-hash
@ -316,7 +325,8 @@ ORDER BY derivations.file_name
minimum-builds
maximum-builds
limit-results
after-name)
after-name
(include-builds? #t))
(define criteria
(string-join
`(,@(filter-map
@ -365,7 +375,9 @@ ORDER BY derivations.file_name
"
SELECT derivations.file_name,
derivations.system,
package_derivations.target,
package_derivations.target"
(if include-builds?
",
(
SELECT JSON_AGG(
json_build_object(
@ -386,7 +398,9 @@ SELECT derivations.file_name,
ON builds.id = latest_build_status.build_id
WHERE builds.derivation_output_details_set_id =
derivations_by_output_details_set.derivation_output_details_set_id
) AS builds
) AS builds"
"")
"
FROM derivations
INNER JOIN derivations_by_output_details_set
ON derivations.id = derivations_by_output_details_set.derivation_id
@ -416,6 +430,10 @@ ORDER BY derivations.file_name
"")))
(map (match-lambda
((file_name system target)
(list file_name
system
target))
((file_name system target builds)
(list file_name
system

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

@ -174,6 +174,8 @@
(target ,parse-target #:multi-value)
(maximum_builds ,parse-number)
(minimum_builds ,parse-number)
(field ,identity #:multi-value
#:default ("system" "target" "builds"))
(after_name ,identity)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
@ -723,6 +725,8 @@
(assq-ref query-parameters 'all_results))
(search-query
(assq-ref query-parameters 'search_query))
(fields
(assq-ref query-parameters 'field))
(derivations
(if search-query
(search-package-derivations-in-revision
@ -734,7 +738,8 @@
#:maximum-builds (assq-ref query-parameters 'maximum_builds)
#:minimum-builds (assq-ref query-parameters 'minimum_builds)
#:limit-results limit-results
#:after-name (assq-ref query-parameters 'after_name))
#:after-name (assq-ref query-parameters 'after_name)
#:include-builds? (member "builds" fields))
(select-package-derivations-in-revision
conn
commit-hash
@ -743,7 +748,8 @@
#:maximum-builds (assq-ref query-parameters 'maximum_builds)
#:minimum-builds (assq-ref query-parameters 'minimum_builds)
#:limit-results limit-results
#:after-name (assq-ref query-parameters 'after_name))))
#:after-name (assq-ref query-parameters 'after_name)
#:include-builds? (member "builds" fields))))
(build-server-urls
(group-to-alist
(match-lambda

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

@ -1052,6 +1052,17 @@ figure {
#:key (path-base "/revision/")
header-text
header-link)
(define field-options
(map
(lambda (field)
(cons field
(hyphenate-words
(string-downcase field))))
'("(no additional fields)" "System" "Target" "Builds")))
(define fields
(assq-ref query-parameters 'field))
(layout
#:body
`(,(header)
@ -1095,6 +1106,11 @@ figure {
,(form-horizontal-control
"Maximum builds" query-parameters
#:help-text "Only show derivations with a maximum number of known builds.")
,(form-horizontal-control
"Fields" query-parameters
#:name "field"
#:options field-options
#:help-text "Fields to return in the response.")
,(form-horizontal-control
"After name" query-parameters
#:help-text
@ -1122,20 +1138,42 @@ figure {
(thead
(tr
(th "File name")
(th "System")
(th "Target")
(th "Builds")))
,@(if (member "system" fields)
'((th "System"))
'())
,@(if (member "target" fields)
'((th "Target"))
'())
,@(if (member "builds" fields)
'((th "Builds"))
'())))
(tbody
,@(map
(match-lambda
((file-name system target)
`(tr
(td (a (@ (href ,file-name))
,(display-store-item-short file-name)))
,@(if (member "system" fields)
`((td (@ (style "font-family: monospace;"))
,system))
'())
,@(if (member "target" fields)
`((td (@ (style "font-family: monospace;"))
,target))
'())))
((file-name system target builds)
`(tr
(td (a (@ (href ,file-name))
,(display-store-item-short file-name)))
(td (@ (style "font-family: monospace;"))
,system)
(td (@ (style "font-family: monospace;"))
,target)
,@(if (member "system" fields)
`((td (@ (style "font-family: monospace;"))
,system))
'())
,@(if (member "target" fields)
`((td (@ (style "font-family: monospace;"))
,target))
'())
(td
(dl
(@ (style "margin-bottom: 0;"))