Add a page to show the derivations in a revision
This commit is contained in:
parent
9a99722643
commit
00bfa5336e
2 changed files with 225 additions and 0 deletions
|
|
@ -44,6 +44,7 @@
|
|||
render-revision-lint-warnings
|
||||
render-revision-package-version
|
||||
render-revision-packages
|
||||
render-revision-derivations
|
||||
render-unknown-revision
|
||||
render-view-revision))
|
||||
|
||||
|
|
@ -55,6 +56,9 @@
|
|||
. (public
|
||||
(max-age . ,cache-control-default-max-age)))))
|
||||
|
||||
(define (parse-system s)
|
||||
s)
|
||||
|
||||
(define (revision-controller request
|
||||
method-and-path-components
|
||||
mime-types
|
||||
|
|
@ -131,6 +135,26 @@
|
|||
(render-unknown-revision mime-types
|
||||
conn
|
||||
commit-hash)))
|
||||
(('GET "revision" commit-hash "derivations")
|
||||
(if (guix-commit-exists? conn commit-hash)
|
||||
(let ((parsed-query-parameters
|
||||
(parse-query-parameters
|
||||
request
|
||||
`((system ,parse-system #:multi-value)
|
||||
(target ,parse-system #:multi-value)
|
||||
(maximum_builds ,parse-number)
|
||||
(minimum_builds ,parse-number)
|
||||
(after_name ,identity)
|
||||
(limit_results ,parse-number #:default 100)))))
|
||||
|
||||
(render-revision-derivations 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
|
||||
|
|
@ -469,6 +493,64 @@
|
|||
#:header-link header-link)
|
||||
#:extra-headers http-headers-for-unchanging-content)))))
|
||||
|
||||
(define* (render-revision-derivations 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-derivations commit-hash
|
||||
query-parameters
|
||||
(valid-systems conn)
|
||||
'()
|
||||
#:path-base path-base
|
||||
#:header-text header-text
|
||||
#:header-link header-link))))
|
||||
(let* ((limit-results
|
||||
(assq-ref query-parameters 'limit_results))
|
||||
(derivations
|
||||
(select-derivations-in-revision
|
||||
conn
|
||||
commit-hash
|
||||
#:systems (assq-ref query-parameters 'system)
|
||||
#:targets (assq-ref query-parameters 'target)
|
||||
#: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)))
|
||||
(show-next-page?
|
||||
(>= (length derivations)
|
||||
limit-results)))
|
||||
(case (most-appropriate-mime-type
|
||||
'(application/json text/html)
|
||||
mime-types)
|
||||
((application/json)
|
||||
(render-json
|
||||
`()))
|
||||
(else
|
||||
(render-html
|
||||
#:sxml (view-revision-derivations commit-hash
|
||||
query-parameters
|
||||
(valid-systems conn)
|
||||
derivations
|
||||
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
|
||||
|
|
|
|||
|
|
@ -30,6 +30,7 @@
|
|||
view-revision-package-and-version
|
||||
view-revision
|
||||
view-revision-packages
|
||||
view-revision-derivations
|
||||
view-revision-lint-warnings
|
||||
unknown-revision))
|
||||
|
||||
|
|
@ -616,6 +617,148 @@
|
|||
"Next page")))
|
||||
'())))))
|
||||
|
||||
(define* (view-revision-derivations commit-hash
|
||||
query-parameters
|
||||
valid-systems
|
||||
derivations
|
||||
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 name or synopsis match the query.")
|
||||
,(form-horizontal-control
|
||||
"System" query-parameters
|
||||
#:options valid-systems
|
||||
#:help-text "Only include derivations for this system."
|
||||
#:font-family "monospace")
|
||||
,(form-horizontal-control
|
||||
"Target" query-parameters
|
||||
#:options valid-systems
|
||||
#:help-text "Only include derivations that are build for this system."
|
||||
#:font-family "monospace")
|
||||
,(form-horizontal-control
|
||||
"Minimum builds" query-parameters
|
||||
#:help-text "Only show derivations with a minimum number of known builds.")
|
||||
,(form-horizontal-control
|
||||
"Maximum builds" query-parameters
|
||||
#:help-text "Only show derivations with a maximum number of known builds.")
|
||||
,(form-horizontal-control
|
||||
"After name" 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"))
|
||||
(table
|
||||
(@ (class "table"))
|
||||
(thead
|
||||
(tr
|
||||
(th "File name")
|
||||
(th "System")
|
||||
(th "Target")))
|
||||
(tbody
|
||||
,@(map
|
||||
(match-lambda
|
||||
((file-name system target builds outputs)
|
||||
(let ((build-server-ids
|
||||
(sort
|
||||
(delete-duplicates
|
||||
(append
|
||||
(map (lambda (build)
|
||||
(assoc-ref build "build_server_id"))
|
||||
(vector->list builds))
|
||||
(append-map
|
||||
(lambda (output)
|
||||
(map (lambda (nar)
|
||||
(assoc-ref nar "build_server_id"))
|
||||
(vector->list
|
||||
(or (assoc-ref output "nars")
|
||||
#()))))
|
||||
(vector->list outputs))))
|
||||
<)))
|
||||
`(tr
|
||||
(td (a (@ (href ,file-name))
|
||||
,(display-store-item-short file-name)))
|
||||
(td (@ (style "font-family: monospace;"))
|
||||
,system)
|
||||
(td (@ (style "font-family: monospace;"))
|
||||
,target)
|
||||
(td ,@(map
|
||||
(lambda (build-server-id)
|
||||
`(div
|
||||
,@(map build-status-alist->build-icon
|
||||
(filter
|
||||
(lambda (build)
|
||||
(eq? build-server-id
|
||||
(assoc-ref build "build_server_id")))
|
||||
(vector->list builds)))
|
||||
,@(map (lambda (output)
|
||||
`(div
|
||||
"Output: " ,(assoc-ref output "output_name")
|
||||
,@(map (lambda (nar)
|
||||
`(div
|
||||
(a (@ (href
|
||||
,(assoc-ref output "output_path")))
|
||||
"Build server "
|
||||
,(assoc-ref nar "build_server_id"))))
|
||||
(filter
|
||||
(lambda (nar)
|
||||
(eq? build-server-id
|
||||
(assoc-ref nar "build_server_id")))
|
||||
(vector->list
|
||||
(or (assoc-ref output "nars")
|
||||
#()))))))
|
||||
(vector->list outputs))))
|
||||
build-server-ids))))))
|
||||
derivations)))
|
||||
,@(if show-next-page?
|
||||
`((div
|
||||
(@ (class "row"))
|
||||
(a (@ (href ,(string-append path-base
|
||||
"?after_name="
|
||||
(car (last derivations)))))
|
||||
"Next page")))
|
||||
'())))))))
|
||||
|
||||
(define* (view-revision-lint-warnings revision-commit-hash
|
||||
query-parameters
|
||||
lint-warnings
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue