From fb301a8495965e7559d357440b8c59ad275ef6bd Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Thu, 3 Oct 2019 21:35:29 +0100
Subject: Add a package page, showing versions for a revision

---
 guix-data-service/model/package.scm  | 19 +++++++++++++++
 guix-data-service/web/controller.scm | 42 ++++++++++++++++++++++++++++++++
 guix-data-service/web/view/html.scm  | 47 ++++++++++++++++++++++++++++++++++++
 3 files changed, 108 insertions(+)

diff --git a/guix-data-service/model/package.scm b/guix-data-service/model/package.scm
index 8a6bb94..1a41a88 100644
--- a/guix-data-service/model/package.scm
+++ b/guix-data-service/model/package.scm
@@ -11,6 +11,7 @@
             count-packages-in-revision
             inferior-packages->package-ids
 
+            select-package-versions-for-revision
             package-versions-for-branch))
 
 (define (select-existing-package-entries package-entries)
@@ -184,6 +185,24 @@ WHERE packages.id IN (
    '(name version package_metadata_id)
    package-entries))
 
+(define (select-package-versions-for-revision conn
+                                              commit
+                                              package-name)
+  (define query "
+SELECT DISTINCT version FROM packages
+INNER JOIN package_derivations
+  ON packages.id = package_derivations.package_id
+INNER JOIN guix_revision_package_derivations
+  ON package_derivations.id = guix_revision_package_derivations.package_derivation_id
+INNER JOIN guix_revisions
+  ON guix_revision_package_derivations.revision_id = guix_revisions.id
+WHERE guix_revisions.commit = $1 AND packages.name = $2
+ORDER BY version")
+
+  (map
+   car
+   (exec-query conn query (list commit package-name))))
+
 (define (package-versions-for-branch conn
                                      git-repository-id
                                      branch-name
diff --git a/guix-data-service/web/controller.scm b/guix-data-service/web/controller.scm
index 71ca560..e63a75d 100644
--- a/guix-data-service/web/controller.scm
+++ b/guix-data-service/web/controller.scm
@@ -278,6 +278,39 @@
                                            #:header-link header-link)
             #:extra-headers http-headers-for-unchanging-content))))))
 
+(define* (render-revision-package mime-types
+                                  conn
+                                  commit-hash
+                                  name
+                                  #:key
+                                  (path-base "/revision/")
+                                  (header-text
+                                   `("Revision "
+                                     (samp ,commit-hash)))
+                                  (header-link
+                                   (string-append
+                                    "/revision/" commit-hash)))
+  (let ((package-versions
+         (select-package-versions-for-revision conn
+                                               commit-hash
+                                               name)))
+    (case (most-appropriate-mime-type
+           '(application/json text/html)
+           mime-types)
+      ((application/json)
+       (render-json
+        `((versions . ,(list->vector package-versions)))
+        #:extra-headers http-headers-for-unchanging-content))
+      (else
+       (render-html
+        #:sxml (view-revision-package commit-hash
+                                      name
+                                      package-versions
+                                      #:path-base path-base
+                                      #:header-text header-text
+                                      #:header-link header-link)
+        #:extra-headers http-headers-for-unchanging-content)))))
+
 (define* (render-revision-package-version mime-types
                                           conn
                                           commit-hash
@@ -811,6 +844,15 @@
          (render-unknown-revision mime-types
                                   conn
                                   commit-hash)))
+    (('GET "revision" commit-hash "package" name)
+     (if (guix-commit-exists? conn commit-hash)
+         (render-revision-package mime-types
+                                  conn
+                                  commit-hash
+                                  name)
+         (render-unknown-revision mime-types
+                                  conn
+                                  commit-hash)))
     (('GET "revision" commit-hash "package" name version)
      (if (guix-commit-exists? conn commit-hash)
          (render-revision-package-version mime-types
diff --git a/guix-data-service/web/view/html.scm b/guix-data-service/web/view/html.scm
index 71f636e..b5c6175 100644
--- a/guix-data-service/web/view/html.scm
+++ b/guix-data-service/web/view/html.scm
@@ -33,6 +33,7 @@
             general-not-found
             unknown-revision
             view-statistics
+            view-revision-package
             view-revision-package-and-version
             view-revision
             view-revision-packages
@@ -308,6 +309,52 @@
                    (style "font-size: 2em; display: block;"))
                 ,derivations-count)))))))
 
+(define* (view-revision-package revision-commit-hash
+                                name
+                                versions
+                                #:key path-base
+                                header-text
+                                header-link)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 (a (@ (href ,header-link))
+               ,@header-text))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h1 "Package " ,name)))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "Versions")
+        (table
+         (@ (class "table"))
+         (thead
+          (tr
+           (th (@ (class "col-sm-10")) "Version")
+           (th (@ (class "col-sm-2")) "")))
+         (tbody
+          ,@(map
+             (lambda (version)
+               `(tr
+                 (td (samp ,version))
+                 (td
+                  (a (@ (href ,(string-append
+                                path-base
+                                revision-commit-hash
+                                "/package/" name "/" version)))
+                     "More information"))))
+             versions)))))))))
+
 (define* (view-revision-package-and-version revision-commit-hash name version
                                             package-metadata
                                             derivations git-repositories
-- 
cgit v1.2.3