guix/data-service
2
0
Fork 0
mirror of git://git.savannah.gnu.org/guix/data-service.git synced 2023-12-14 03:23:03 +01:00
Code Issues Releases Wiki Activity

Improve latest processed revision pages for reproducibility stuff

Browse source 
Support the package-derivation-outputs page, and switch the
package-reproducibility page across to use it.
This commit is contained in:
Christopher Baines 2020-10-11 17:05:38 +01:00
parent efbbac5099
commit d05a7397fb
3 changed files with 78 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

59
guix-data-service/web/repository/controller.scm
View file

@ -292,6 +292,50 @@
(render-no-latest-revision mime-types
repository-id
branch-name))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-derivation-outputs")
(letpar& ((commit-hash
(with-thread-postgresql-connection
(lambda (conn)
(latest-processed-commit-for-branch conn
repository-id
branch-name)))))
(if commit-hash
(let ((parsed-query-parameters
(guard-against-mutually-exclusive-query-parameters
(parse-query-parameters
request
`((search_query ,identity)
(after_path ,identity)
(substitutes_available_from ,parse-number
#:multi-value)
(substitutes_not_available_from ,parse-number
#:multi-value)
(output_consistency ,identity
#:default "any")
(system ,parse-system #:default "x86_64-linux")
(target ,parse-target)
(limit_results ,parse-result-limit
#:no-default-when (all_results)
#:default 10)
(all_results ,parse-checkbox-value)))
'((limit_results all_results)))))
(render-revision-package-derivation-outputs
mime-types
commit-hash
parsed-query-parameters
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/repository/" repository-id
"/branch/" branch-name
"/latest-processed-revision")))
(render-no-latest-revision mime-types
repository-id
branch-name))))
(('GET "repository" repository-id "branch" branch-name "latest-processed-revision" "package-reproducibility")
(letpar& ((commit-hash
(with-thread-postgresql-connection
@ -300,9 +344,18 @@
repository-id
branch-name)))))
(if commit-hash
(render-revision-package-reproduciblity mime-types
commit-hash
#:path-base path)
(render-revision-package-reproduciblity
mime-types
commit-hash
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/repository/" repository-id
"/branch/" branch-name
"/latest-processed-revision"))
(render-no-latest-revision mime-types
repository-id
branch-name))))

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

@ -58,6 +58,7 @@
render-revision-package-reproduciblity
render-revision-package-substitute-availability
render-revision-package-derivations
render-revision-package-derivation-outputs
render-unknown-revision
render-view-revision))
@ -560,7 +561,14 @@
(define* (render-revision-package-reproduciblity mime-types
commit-hash
#:key path-base)
#:key
(path-base "/revision/")
(header-text
`("Revision "
(samp ,commit-hash)))
(header-link
(string-append "/revision/"
commit-hash)))
(letpar& ((output-consistency
(with-thread-postgresql-connection
(lambda (conn)
@ -575,7 +583,10 @@
(render-html
#:sxml (view-revision-package-reproducibility
commit-hash
output-consistency))))))
output-consistency
#:path-base path-base
#:header-text header-text
#:header-link header-link))))))
(define (render-revision-news mime-types
commit-hash

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

@ -1248,7 +1248,10 @@ figure {
substitute-availability)))))
(define* (view-revision-package-reproducibility revision-commit-hash
output-consistency)
output-consistency
#:key (path-base "/revision/")
header-text
header-link)
(layout
#:body
`(,(header)
@ -1320,8 +1323,8 @@ figure {
(div
(@ (class "col-sm-12"))
(h3 (a (@ (style "white-space: nowrap;")
(href ,(string-append "/revision/" revision-commit-hash)))
"Revision " (samp ,revision-commit-hash)))
(href ,header-link))
,@header-text))
(h1 "Package reproducibility")))
(div
(@ (class "row"))
@ -1470,7 +1473,9 @@ figure {
colour ";"))))
(a (@ (href
,(string-append
"/revision/" revision-commit-hash
(string-join
(drop-right (string-split path-base #\/) 1)
"/")
"/package-derivation-outputs?"
"output_consistency=" key
"&system=" system)))