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-lint-warnings
|
||||||
render-revision-package-version
|
render-revision-package-version
|
||||||
render-revision-packages
|
render-revision-packages
|
||||||
|
render-revision-derivations
|
||||||
render-unknown-revision
|
render-unknown-revision
|
||||||
render-view-revision))
|
render-view-revision))
|
||||||
|
|
||||||
|
|
@ -55,6 +56,9 @@
|
||||||
. (public
|
. (public
|
||||||
(max-age . ,cache-control-default-max-age)))))
|
(max-age . ,cache-control-default-max-age)))))
|
||||||
|
|
||||||
|
(define (parse-system s)
|
||||||
|
s)
|
||||||
|
|
||||||
(define (revision-controller request
|
(define (revision-controller request
|
||||||
method-and-path-components
|
method-and-path-components
|
||||||
mime-types
|
mime-types
|
||||||
|
|
@ -131,6 +135,26 @@
|
||||||
(render-unknown-revision mime-types
|
(render-unknown-revision mime-types
|
||||||
conn
|
conn
|
||||||
commit-hash)))
|
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")
|
(('GET "revision" commit-hash "lint-warnings")
|
||||||
(if (guix-commit-exists? conn commit-hash)
|
(if (guix-commit-exists? conn commit-hash)
|
||||||
(let ((parsed-query-parameters
|
(let ((parsed-query-parameters
|
||||||
|
|
@ -469,6 +493,64 @@
|
||||||
#:header-link header-link)
|
#:header-link header-link)
|
||||||
#:extra-headers http-headers-for-unchanging-content)))))
|
#: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
|
(define* (render-revision-lint-warnings mime-types
|
||||||
conn
|
conn
|
||||||
commit-hash
|
commit-hash
|
||||||
|
|
|
||||||
|
|
@ -30,6 +30,7 @@
|
||||||
view-revision-package-and-version
|
view-revision-package-and-version
|
||||||
view-revision
|
view-revision
|
||||||
view-revision-packages
|
view-revision-packages
|
||||||
|
view-revision-derivations
|
||||||
view-revision-lint-warnings
|
view-revision-lint-warnings
|
||||||
unknown-revision))
|
unknown-revision))
|
||||||
|
|
||||||
|
|
@ -616,6 +617,148 @@
|
||||||
"Next page")))
|
"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
|
(define* (view-revision-lint-warnings revision-commit-hash
|
||||||
query-parameters
|
query-parameters
|
||||||
lint-warnings
|
lint-warnings
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue