mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add a page to show derivation outputs for a revision
This commit is contained in:
Christopher Baines
parent
eecfdeb9e4
commit
7dc0238436
2 changed files with 179 additions and 0 deletions
|
|
@ -163,6 +163,30 @@
|
|||
(render-unknown-revision mime-types
|
||||
conn
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "derivation-outputs")
|
||||
(if (guix-commit-exists? conn commit-hash)
|
||||
(let ((parsed-query-parameters
|
||||
(guard-against-mutually-exclusive-query-parameters
|
||||
(parse-query-parameters
|
||||
request
|
||||
`((after_path ,identity)
|
||||
(limit_results ,parse-result-limit
|
||||
#:no-default-when (all_results)
|
||||
#:default 100)
|
||||
(all_results ,parse-checkbox-value)))
|
||||
;; You can't specify a search query, but then also limit the
|
||||
;; results by filtering for after a particular output path
|
||||
'((after_path search_query)
|
||||
(limit_results all_results)))))
|
||||
|
||||
(render-revision-derivation-outputs mime-types
|
||||
conn
|
||||
commit-hash
|
||||
parsed-query-parameters
|
||||
#:path-base path))
|
||||
(render-unknown-revision mime-types
|
||||
conn
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "lint-warnings")
|
||||
(if (guix-commit-exists? conn commit-hash)
|
||||
(let ((parsed-query-parameters
|
||||
|
|
@ -563,6 +587,62 @@
|
|||
#:header-text header-text
|
||||
#:header-link header-link)))))))
|
||||
|
||||
(define* (render-revision-derivation-outputs mime-types
|
||||
conn
|
||||
commit-hash
|
||||
query-parameters
|
||||
#:key
|
||||
(path-base "/revision/")
|
||||
(header-text
|
||||
`("Revision " (samp ,commit-hash)))
|
||||
(header-link
|
||||
(string-append "/revision/" commit-hash)))
|
||||
(if (any-invalid-query-parameters? query-parameters)
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`((error . "invalid query"))))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (view-revision-derivation-outputs commit-hash
|
||||
query-parameters
|
||||
'()
|
||||
#:path-base path-base
|
||||
#:header-text header-text
|
||||
#:header-link header-link))))
|
||||
(let* ((limit-results
|
||||
(assq-ref query-parameters 'limit_results))
|
||||
(all-results
|
||||
(assq-ref query-parameters 'all_results))
|
||||
(derivation-outputs
|
||||
(select-derivation-outputs-in-revision
|
||||
conn
|
||||
commit-hash
|
||||
#:limit-results limit-results
|
||||
#:after-path (assq-ref query-parameters 'after_path)))
|
||||
(show-next-page?
|
||||
(if all-results
|
||||
#f
|
||||
(>= (length derivation-outputs)
|
||||
limit-results))))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`()))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (view-revision-derivation-outputs commit-hash
|
||||
query-parameters
|
||||
derivation-outputs
|
||||
show-next-page?
|
||||
#:path-base path-base
|
||||
#:header-text header-text
|
||||
#:header-link header-link)))))))
|
||||
|
||||
(define* (render-revision-lint-warnings mime-types
|
||||
conn
|
||||
commit-hash
|
||||
|
|
|
|||
|
|
@ -31,6 +31,7 @@
|
|||
view-revision
|
||||
view-revision-packages
|
||||
view-revision-derivations
|
||||
view-revision-derivation-outputs
|
||||
view-revision-lint-warnings
|
||||
unknown-revision))
|
||||
|
||||
|
|
@ -760,6 +761,104 @@
|
|||
"Next page")))
|
||||
'())))))))
|
||||
|
||||
(define* (view-revision-derivation-outputs commit-hash
|
||||
query-parameters
|
||||
derivation-outputs
|
||||
show-next-page?
|
||||
#:key (path-base "/revision/")
|
||||
header-text
|
||||
header-link)
|
||||
(layout
|
||||
#:body
|
||||
`(,(header)
|
||||
(div
|
||||
(@ (class "container"))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-sm-12"))
|
||||
(h3 (a (@ (style "white-space: nowrap;")
|
||||
(href ,header-link))
|
||||
,@header-text))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
(div
|
||||
(@ (class "well"))
|
||||
(form
|
||||
(@ (method "get")
|
||||
(action "")
|
||||
(style "padding-bottom: 0")
|
||||
(class "form-horizontal"))
|
||||
,(form-horizontal-control
|
||||
"Search query" query-parameters
|
||||
#:help-text
|
||||
"List packages where the derivation output path matches this query.")
|
||||
,(form-horizontal-control
|
||||
"Reproducibility status" query-parameters
|
||||
#:options '(("Any" . "any")
|
||||
("Unknown" . "unknown")
|
||||
("Reproducible" . "reproducible")
|
||||
("Unreproducible" . "unreproducible"))
|
||||
#:help-text "Do the known hashes for this output suggest it's reproducible, or not reproducible.")
|
||||
,(form-horizontal-control
|
||||
"After path" query-parameters
|
||||
#:help-text
|
||||
"List packages that are alphabetically after the given name.")
|
||||
,(form-horizontal-control
|
||||
"Limit results" query-parameters
|
||||
#:help-text "The maximum number of packages by name 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")
|
||||
(class "btn btn-lg btn-primary"))
|
||||
"Update results")))))))
|
||||
(div
|
||||
(@ (class "row"))
|
||||
(div
|
||||
(@ (class "col-md-12"))
|
||||
(p "Showing " ,(length derivation-outputs) " results")
|
||||
(table
|
||||
(@ (class "table"))
|
||||
(thead
|
||||
(tr
|
||||
(th "Path")
|
||||
(th "Hash")
|
||||
(th "Nars")))
|
||||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
((path hash-algorithm hash recursive nars)
|
||||
`(tr
|
||||
(td (a (@ (href ,path))
|
||||
,(display-store-item-short path)))
|
||||
(td
|
||||
,@(if
|
||||
(null? hash-algorithm)
|
||||
'()
|
||||
`(,hash)))
|
||||
(td
|
||||
,@(map (lambda (nar)
|
||||
`(div
|
||||
,(assoc-ref nar "build_server_id")
|
||||
" "
|
||||
,(assoc-ref nar "hash")))
|
||||
(vector->list nars))))))
|
||||
derivation-outputs)))
|
||||
,@(if show-next-page?
|
||||
`((div
|
||||
(@ (class "row"))
|
||||
(a (@ (href ,(string-append path-base
|
||||
"?after_path="
|
||||
(car (last derivation-outputs)))))
|
||||
"Next page")))
|
||||
'())))))))
|
||||
|
||||
(define* (view-revision-lint-warnings revision-commit-hash
|
||||
query-parameters
|
||||
lint-warnings
|
||||
|
|
|
|||
Loading…
Reference in a new issue