aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix-data-service/web/controller.scm97
-rw-r--r--guix-data-service/web/view/html.scm54
2 files changed, 107 insertions, 44 deletions
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 76b6a59..9ef0554 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -92,9 +92,12 @@
target-commit
(commit->revision-id conn target-commit))))
-(define (render-view-revision mime-types
- conn
- commit-hash)
+(define* (render-view-revision mime-types
+ conn
+ 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
- conn
- commit-hash
- query-parameters)
+(define* (render-revision-packages 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)
@@ -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
- conn
- commit-hash
- name
- version)
+(define* (render-revision-package mime-types
+ conn
+ commit-hash
+ name
+ 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))))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 61a24f2..5373ad7 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -316,9 +316,11 @@
(style "font-size: 2em; display: block;"))
,derivations-count)))))))
-(define (view-revision-package-and-version revision-commit-hash name version
- package-metadata
- derivations git-repositories)
+(define* (view-revision-package-and-version revision-commit-hash name version
+ package-metadata
+ 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
- query-parameters
- packages
- git-repositories
- show-next-page?)
+(define* (view-revision-packages revision-commit-hash
+ query-parameters
+ packages
+ git-repositories
+ 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)