Add a new page to show package versions available on a branch

This is useful when looking back through history at what package versions were
previously available.

3 files changed, 107 insertions, 1 deletions

diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
index b3327ca..8a6bb94 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -9,7 +9,9 @@
             select-packages-in-revision
             search-packages-in-revision
             count-packages-in-revision
-            inferior-packages->package-ids))
+            inferior-packages->package-ids
+
+            package-versions-for-branch))
 
 (define (select-existing-package-entries package-entries)
   (string-append "SELECT id, packages.name, packages.version, "
@@ -181,3 +183,33 @@ WHERE packages.id IN (
    "packages"
    '(name version package_metadata_id)
    package-entries))
+
+(define (package-versions-for-branch conn
+                                     git-repository-id
+                                     branch-name
+                                     package-name)
+  (exec-query
+   conn
+   "
+SELECT package_version,
+       first_guix_revisions.commit AS first_guix_revision_commit,
+       first_git_branches.datetime AS first_datetime,
+       last_guix_revisions.commit AS last_guix_revision_commit,
+       last_git_branches.datetime AS last_datetime
+FROM package_versions_by_guix_revision_range
+INNER JOIN guix_revisions AS first_guix_revisions
+  ON first_guix_revision_id = first_guix_revisions.id
+INNER JOIN git_branches AS first_git_branches
+  ON first_guix_revisions.git_repository_id = first_git_branches.git_repository_id AND first_guix_revisions.commit = first_git_branches.commit
+INNER JOIN guix_revisions AS last_guix_revisions
+  ON last_guix_revision_id = last_guix_revisions.id
+INNER JOIN git_branches AS last_git_branches
+  ON last_guix_revisions.git_repository_id = last_git_branches.git_repository_id AND last_guix_revisions.commit = last_git_branches.commit
+WHERE package_name = $1
+AND package_versions_by_guix_revision_range.git_repository_id = $2
+AND package_versions_by_guix_revision_range.branch_name = $3
+ORDER BY first_datetime DESC"
+   (list package-name
+         (number->string git-repository-id)
+         branch-name)))
+
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index f497d32..77fcc93 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -882,6 +882,17 @@
                                             'after_date)
                      #:before-date (assq-ref parsed-query-parameters
                                              'before_date)))))))
+    (('GET "repository" repository-id "branch" branch-name "package" package-name)
+     (render-html
+      #:sxml (view-branch-package
+              repository-id
+              branch-name
+              package-name
+              (package-versions-for-branch
+               conn
+               (string->number repository-id)
+               branch-name
+               package-name))))
     (('GET "repository" repository-id "branch" branch-name "latest-processed-revision")
      (let ((commit-hash
             (latest-processed-commit-for-branch conn repository-id branch-name)))
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 11833de..3827f5f 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -40,6 +40,7 @@
             view-git-repository
             view-branches
             view-branch
+            view-branch-package
             view-builds
             view-derivation
             view-store-item
@@ -1088,6 +1089,68 @@
                           (cdr branch-commits))
                      '((#f #f))))))))))))
 
+(define (view-branch-package git-repository-id
+                             branch-name
+                             package-name
+                             versions-by-revision-range)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (a (@ (href ,(string-append "/repository/" git-repository-id)))
+           (h3 "Repository"))
+        (a (@ (href ,(string-append "/repository/" git-repository-id
+                                    "/branch/" branch-name)))
+           (h3 ,(string-append branch-name " branch")))
+        (h1 (@ (style "white-space: nowrap;"))
+            (samp ,package-name))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-md-12"))
+        (table
+         (@ (class "table")
+            (style "table-layout: fixed;"))
+         (thead
+          (tr
+           (th (@ (class "col-sm-4")) "Version")
+           (th (@ (class "col-sm-4")) "From")
+           (th (@ (class "col-sm-4")) "To")))
+         (tbody
+          ,@(map
+             (match-lambda
+               ((package-version first-guix-revision-commit
+                                 first-datetime
+                                 last-guix-revision-commit
+                                 last-datetime)
+                `(tr
+                  (td ,package-version)
+                  (td (a (@ (href ,(string-append
+                                    "/revision/" first-guix-revision-commit)))
+                         ,first-datetime)
+                      (br)
+                      (a (@ (href ,(string-append
+                                    "/revision/"
+                                    first-guix-revision-commit
+                                    "/package/"
+                                    package-name "/" package-version)))
+                         "(More information)"))
+                  (td (a (@ (href ,(string-append
+                                    "/revision/" last-guix-revision-commit)))
+                         ,last-datetime)
+                      (br)
+                      (a (@ (href ,(string-append
+                                    "/revision/"
+                                    last-guix-revision-commit
+                                    "/package/"
+                                    package-name "/" package-version)))
+                         "(More information)")))))
+             versions-by-revision-range)))))))))
 
 (define (view-builds stats builds)
   (layout