Set more informative page titles

For many pages where previously the title was just "Guix Data Service".

Signed-off-by: Christopher Baines <mail@cbaines.net>
This commit is contained in:
Canan Talayhan 2021-04-23 11:19:32 +03:00 committed by Christopher Baines
parent 6387f1bc67
commit fe97021cd0
10 changed files with 172 additions and 25 deletions

View file

@ -27,7 +27,11 @@
(define (view-build query-parameters
build
required-failed-builds)
(define page-header "Build")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -36,7 +40,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Build")))
(h1 ,page-header)))
(div
(@ (class "row"))
,@(match build
@ -98,7 +102,11 @@
'())))))
(define (view-build-servers build-servers)
(define page-header "Build servers")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -107,7 +115,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h2 "Build servers")
(h2 ,page-header)
,@(map
(match-lambda
((id url lookup-all-derivations? lookup-builds?)
@ -127,7 +135,11 @@
build-servers)))))))
(define (view-build-server build-server)
(define page-header "Build server")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -136,7 +148,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h2 "Build server")
(h2 ,page-header)
,(match build-server
((url lookup-all-derivations?)
`(dl
@ -150,7 +162,11 @@
"No")))))))))))
(define (view-signing-key sexp)
(define page-header "Signing key")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -159,5 +175,5 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h2 "Signing key")
(h2 ,page-header)
,(sexp-div sexp)))))))

View file

@ -29,7 +29,11 @@
valid-targets
stats
builds)
(define page-header "Builds")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -38,7 +42,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Builds")
(h1 ,page-header)
(table
(@ (class "table"))
(thead

View file

@ -97,6 +97,11 @@
(query-parameters->string query-parameters)))
(layout
#:title
(if invalid-query?
"Compare"
(string-append "Comparing " (string-take base-commit 8) " and "
(string-take target-commit 8)))
#:body
`(,(header)
(div
@ -420,6 +425,8 @@
(style "font-size: 1.5em; padding-right: 0.4em;"))))
(layout
#:title
"Comparing derivations"
#:body
`(,(header)
(div
@ -685,7 +692,11 @@
(define fields
(assq-ref query-parameters 'field))
(define page-header "Package derivation changes")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -835,7 +846,7 @@ enough builds to determine a change")))
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Package derivation changes")
(h1 ,page-header)
,(if
(null? derivation-changes)
'(p "No derivation changes")
@ -950,7 +961,14 @@ enough builds to determine a change")))
(string-append "?base_commit=" base-commit
"&target_commit=" target-commit))
(define page-header
(string-append "Comparing "
(string-take base-commit 8) " and "
(string-take target-commit 8)))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -1042,7 +1060,11 @@ enough builds to determine a change")))
#:optional
base-revision-details
target-revision-details)
(define page-header "System test derivation changes")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -1141,7 +1163,7 @@ enough builds to determine a change")))
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "System test derivation changes")
(h1 ,page-header)
,(if
(null? changes)
'(p "No system test derivation changes")

View file

@ -22,7 +22,11 @@
#:export (view-dumps))
(define (view-dumps available-dumps)
(define page-header "Database dumps")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -31,7 +35,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Database dumps")))
(h1 ,page-header)))
,@(map
(match-lambda
((date-string . files)

View file

@ -30,7 +30,11 @@
jobs-and-events
recent-events
show-next-page?)
(define page-header "Jobs")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -40,7 +44,7 @@
(div
(@ (class "col-sm-12"))
(h1 (@ (style "display: inline-block;"))
"Jobs")
,page-header)
(div
(@ (class "btn-group pull-right")
(style "margin-top: 1.3rem;")
@ -189,7 +193,11 @@
(define (view-job-events query-parameters
recent-events)
(define page-header "Recent events")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -200,7 +208,7 @@
(@ (class "col-sm-12"))
(a (@ (href "/jobs"))
(h3 "Jobs"))
(h1 "Recent events")))
(h1 ,page-header)))
(div
(@ (class "row"))
(div
@ -256,7 +264,14 @@
recent-events)))))))))
(define (view-job-queue jobs-and-events)
(define page-header
(string-append "Queued jobs ("
(number->string (length jobs-and-events))
")"))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -267,9 +282,7 @@
(@ (class "col-sm-12"))
(a (@ (href "/jobs"))
(h3 "Jobs"))
(h1 "Queued jobs ("
,(length jobs-and-events)
")")))
(h1 ,page-header)))
(div
(@ (class "row"))
(div
@ -330,7 +343,11 @@
jobs-and-events)))))))))
(define (view-job job-id query-parameters log)
(define page-header (string-append "Job " job-id))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -339,7 +356,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Job " ,job-id)))
(h1 ,page-header)))
(div
(@ (class "row"))
(div

View file

@ -22,7 +22,10 @@
#:export (view-substitutes))
(define (view-substitutes narinfo-signing-public-key)
(define page-header "Substitutes")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -31,7 +34,7 @@
(@ (class "row"))
(div
(@ (class "col-sm-12"))
(h1 "Substitutes")
(h1 ,page-header)
,@(if (canonical-sexp? narinfo-signing-public-key)
`((h3 "Public key")
(pre

View file

@ -25,6 +25,8 @@
(define* (view-package name package-version-with-branches)
(layout
#:title
(string-append "Package: " name)
#:body
`(,(header)
(div

View file

@ -32,7 +32,11 @@
view-no-latest-revision))
(define* (view-git-repositories git-repositories)
(define page-header "Git repositories")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -41,7 +45,7 @@
(@ (class "row"))
(div
(@ (class "col-md-12"))
(h1 "Git repositories")))
(h1 ,page-header)))
,@(map
(match-lambda
((id label url cgit-base-url)
@ -65,7 +69,11 @@
(define* (view-git-repository git-repository-id
label url cgit-url-base
branches-with-most-recent-commits)
(define page-header (string-append "Repository " (string-drop url 8)))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -86,7 +94,11 @@
(define (view-branch git-repository-id
branch-name query-parameters branch-commits)
(define page-header (string-append branch-name " branch"))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -197,7 +209,11 @@
branch-name
package-name
versions-by-revision-range)
(define page-header (string-append package-name " on " branch-name))
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -386,6 +402,8 @@
(map first derivations-by-revision-range))))
(layout
#:title
(string-append package-name " package derivations")
#:body
`(,(header)
(div
@ -636,6 +654,8 @@
(map first outputs-by-revision-range))))
(layout
#:title
(string-append package-name " package outputs")
#:body
`(,(header)
(div
@ -849,6 +869,8 @@
valid-systems
system-test-history)
(layout
#:title
(string-append system-test-name " history")
#:body
`(,(header)
(div
@ -1016,12 +1038,16 @@
'(#f))))))))))))
(define (view-no-latest-revision branch-name)
(define page-header "No latest revision")
(layout
#:title
(string-append page-header " for " branch-name)
#:body
`(,(header)
(div
(@ (class "container"))
(h1 "No latest revision")
(h1 ,page-header)
(p "No latest revision for "
(strong (samp ,branch-name))
" branch")))))

View file

@ -49,6 +49,9 @@
query-parameters
news-entries)
(layout
#:title
(string-append "Channel News Entries - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -108,6 +111,9 @@
header-text
header-link)
(layout
#:title
(string-append "Package: " name " - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(div
@ -135,7 +141,7 @@
branch-name))))
branches)))
git-repositories-and-branches)
(h1 "Package " ,name)))
(h1 "Package: " ,name)))
(div
(@ (class "row"))
(div
@ -170,6 +176,9 @@
header-link
version-history-link)
(layout
#:title
(string-append "Package: " name " @ " version " - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(div
@ -224,7 +233,7 @@
(role "button"))
"Version history"))
'())
(h1 "Package " ,name " @ " ,version)))
(h1 "Package: " ,name " @ " ,version)))
(div
(@ (class "row"))
(div
@ -472,6 +481,8 @@
#:key (path-base "/revision/")
header-text)
(layout
#:title
(string-append "Revision " (string-take commit-hash 7))
#:body
`(,(header)
(div
@ -548,6 +559,9 @@
"Home page" "Location" "Licenses")))
(layout
#:title
(string-append "Packages - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(div
@ -756,6 +770,9 @@
package-description-counts))
(layout
#:title
(string-append "Packages translation availability - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -836,6 +853,8 @@
#:key (path-base "/revision/")
header-text header-link)
(layout
#:title
(string-append "System tests - Revision " (string-take commit-hash 7))
#:body
`(,(header)
(div
@ -937,6 +956,9 @@
#:key (path-base "/revision/")
header-text header-link)
(layout
#:title
(string-append "Channel instances - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -1217,6 +1239,9 @@ figure {
colours))))))
(layout
#:title
(string-append "Package substitute availability - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(style ,chart-css)
@ -1255,6 +1280,9 @@ figure {
header-text
header-link)
(layout
#:title
(string-append "Package reproducibility - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(style "
@ -1522,6 +1550,9 @@ figure {
(assq-ref query-parameters 'field))
(layout
#:title
(string-append "Package derivations - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -1703,6 +1734,9 @@ figure {
))
(layout
#:title
(string-append "Fixed output package derivations - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -1843,6 +1877,9 @@ figure {
build-server-urls))
(layout
#:title
(string-append "Package derivation outputs - Revision "
(string-take commit-hash 7))
#:body
`(,(header)
(div
@ -2022,6 +2059,8 @@ figure {
stats
builds)
(layout
#:title
(string-append "Builds - Revision " (string-take commit-hash 7))
#:body
`(,(header)
(div
@ -2159,6 +2198,9 @@ figure {
'("Linter" "Message" "Location")))
(layout
#:title
(string-append "Lint warnings - Revision "
(string-take revision-commit-hash 7))
#:body
`(,(header)
(div
@ -2314,7 +2356,11 @@ figure {
(define (unknown-revision commit-hash job git-repositories-and-branches
jobs-and-events)
(define page-header "Unknown revision")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -2347,13 +2393,16 @@ figure {
(strong (@ (class "text-center")
(style "font-size: 2em; display: block;"))
"Unknown"))))
`((h1 "Unknown revision")
`((h1 ,page-header)
(p "No known revision with commit "
(strong (samp ,commit-hash)))))))))
(define (unprocessed-revision commit-hash job git-repositories-and-branches
jobs-and-events)
(define page-header "Unknown revision")
(layout
#:title
page-header
#:body
`(,(header)
(div
@ -2375,6 +2424,6 @@ figure {
git-repositories-and-branches
commit-hash))
,@(view-revision/jobs-and-events jobs-and-events))))
`((h1 "Unknown revision")
`((h1 ,page-header)
(p "No known revision with commit "
(strong (samp ,commit-hash)))))))))

View file

@ -65,13 +65,15 @@
(define* (layout #:key
(head '())
(body '())
(title "Guix Data Service")
title
description)
`((doctype "html")
(html
(@ (lang "en"))
(head
(title ,title)
(title ,(if title
(string-append title " — Guix Data Service")
"Guix Data Service"))
(meta (@ (http-equiv "Content-Type")
(content "text/html; charset=UTF-8")))
(meta (@ (name "viewport")
@ -286,8 +288,7 @@
(define (index git-repositories-and-revisions)
(layout
#:description
"The Guix Data Service processes, stores and provides data about Guix over
time."
"The Guix Data Service processes, stores and provides data about Guix over time."
#:body
`(,(header)
(div
@ -334,7 +335,10 @@ time."
git-repositories-and-revisions)))))
(define (view-statistics guix-revisions-count derivations-count)
(define page-header "Statistics")
(layout
#:title
page-header
#:body
`(,(header)
(div