Make some pages around revisions more generic

So that they can also be used for the /branch/foo/latest-processed-revision
pages. The content is the same, but the title, link, and some of the links on
the page are different.
This commit is contained in:
Christopher Baines 2019-06-16 10:27:14 +01:00
parent 33956b394f
commit de8858c274
2 changed files with 107 additions and 44 deletions

View file

@ -92,9 +92,12 @@
target-commit
(commit->revision-id conn target-commit))))
(define (render-view-revision mime-types
(define* (render-view-revision mime-types
conn
commit-hash)
commit-hash
#:key path-base
(header-text
`("Revision " (samp ,commit-hash))))
(let ((packages-count
(count-packages-in-revision conn commit-hash))
(git-repositories-and-branches
@ -121,7 +124,9 @@
commit-hash
packages-count
git-repositories-and-branches
derivations-counts)
derivations-counts
#:path-base path-base
#:header-text header-text)
#:extra-headers http-headers-for-unchanging-content)))))
(define (texinfo->variants-alist s)
@ -148,10 +153,16 @@
(select-job-for-commit
conn commit-hash))))))
(define (render-revision-packages mime-types
(define* (render-revision-packages mime-types
conn
commit-hash
query-parameters)
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)
@ -238,14 +249,24 @@
query-parameters
packages
git-repositories
show-next-page?)
show-next-page?
#:path-base path-base
#:header-text header-text
#:header-link header-link)
#:extra-headers http-headers-for-unchanging-content))))))
(define (render-revision-package mime-types
(define* (render-revision-package mime-types
conn
commit-hash
name
version)
version
#:key
(header-text
`("Revision "
(samp ,commit-hash)))
(header-link
(string-append
"/revision/" commit-hash)))
(let ((metadata
(select-package-metadata-by-revision-name-and-version
conn
@ -288,7 +309,9 @@
version
metadata
derivations
git-repositories)
git-repositories
#:header-text header-text
#:header-link header-link)
#:extra-headers http-headers-for-unchanging-content)))))
(define (render-compare-unknown-commit mime-types
@ -586,6 +609,9 @@
uri-query
parse-query-string))
(define path
(uri-path (request-uri request)))
(match method-and-path-components
((GET)
(render-html
@ -617,7 +643,8 @@
((GET "revision" commit-hash) (if (guix-commit-exists? conn commit-hash)
(render-view-revision mime-types
conn
commit-hash)
commit-hash
#:path-base path)
(render-unknown-revision mime-types
conn
commit-hash)))
@ -643,7 +670,8 @@
(render-revision-packages mime-types
conn
commit-hash
parsed-query-parameters))
parsed-query-parameters
#:path-base path))
(render-unknown-revision mime-types
conn
commit-hash)))
@ -688,7 +716,11 @@
(if commit-hash
(render-view-revision mime-types
conn
commit-hash)
commit-hash
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name)))
(render-unknown-revision mime-types
conn
commit-hash))))
@ -716,7 +748,34 @@
(render-revision-packages mime-types
conn
commit-hash
parsed-query-parameters))
parsed-query-parameters
#:path-base path
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/branch/" branch-name
"/latest-processed-revision")))
(render-unknown-revision mime-types
conn
commit-hash))))
((GET "branch" branch-name "latest-processed-revision" "package" name version)
(let ((commit-hash
(latest-processed-commit-for-branch conn branch-name)))
(if commit-hash
(render-revision-package mime-types
conn
commit-hash
name
version
#:header-text
`("Latest processed revision for branch "
(samp ,branch-name))
#:header-link
(string-append
"/branch/" branch-name
"/latest-processed-revision"))
(render-unknown-revision mime-types
conn
commit-hash))))

View file

@ -316,9 +316,11 @@
(style "font-size: 2em; display: block;"))
,derivations-count)))))))
(define (view-revision-package-and-version revision-commit-hash name version
(define* (view-revision-package-and-version revision-commit-hash name version
package-metadata
derivations git-repositories)
derivations git-repositories
#:key header-text
header-link)
(layout
#:body
`(,(header)
@ -328,9 +330,8 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 (a (@ (href ,(string-append
"/revision/" revision-commit-hash)))
"Revision " (samp ,revision-commit-hash)))))
(h3 (a (@ (href ,header-link))
,@header-text))))
(div
(@ (class "row"))
(div
@ -405,8 +406,10 @@
(td ,(build-status-span status)))))
derivations)))))))))
(define (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count)
(define* (view-revision commit-hash packages-count
git-repositories-and-branches derivations-count
#:key (path-base "/revision/")
header-text)
(layout
#:body
`(,(header)
@ -417,17 +420,16 @@
(div
(@ (class "col-md-12"))
(h1 (@ (style "white-space: nowrap;"))
"Revision " (samp ,commit-hash))))
,@header-text)))
(div
(@ (class "row"))
(div
(@ (class "col-md-6"))
(h3 "Packages")
(h2 "Packages")
(strong (@ (class "text-center")
(style "font-size: 2em; display: block;"))
,packages-count)
(a (@ (href ,(string-append "/revision/" commit-hash
"/packages")))
(a (@ (href ,(string-append path-base "/packages")))
"View packages")
,@(if
@ -476,11 +478,13 @@
(td (samp ,count))))))
derivations-count)))))))))
(define (view-revision-packages revision-commit-hash
(define* (view-revision-packages revision-commit-hash
query-parameters
packages
git-repositories
show-next-page?)
show-next-page?
#:key path-base
header-text header-link)
(define field-options
(map
(lambda (field)
@ -499,9 +503,9 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h3 (a (@ (href ,(string-append
"/revision/" revision-commit-hash)))
"Revision " (samp ,revision-commit-hash)))))
(h3 (a (@ (style "white-space: nowrap;")
(href ,header-link))
,@header-text))))
(div
(@ (class "row"))
(div
@ -546,7 +550,7 @@
(href ,(let ((query-parameter-string
(query-parameters->string query-parameters)))
(string-append
"/revision/" revision-commit-hash "/packages.json"
path-base ".json"
(if (string-null? query-parameter-string)
""
(string-append "?" query-parameter-string))))))
@ -628,20 +632,20 @@
'())
(td (@ (class "text-right"))
(a (@ (href ,(string-append
"/revision/" revision-commit-hash
"/package/" name "/" version)))
(string-drop-right path-base 1)
"/" name "/" version)))
"More information")))))
packages))))))
,@(if show-next-page?
`((div
(@ (class "row"))
(a (@ (href ,(string-append "/revision/" revision-commit-hash
(a (@ (href ,(string-append path-base revision-commit-hash
"/packages?after_name="
(car (last packages)))))
"Next page")))
'())))))
(define (view-branches branches-with-most-recent-commits)
(define* (view-branches branches-with-most-recent-commits)
(layout
#:body
`(,(header)