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.

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)