From ba9e20ee751669a916fb6886ca98a67f361df0f1 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 31 Oct 2023 19:53:16 +0000
Subject: Add a simple package page

---
 Makefile.am                        |  2 ++
 guix-qa-frontpage/package.scm      | 21 +++++++++++++++++++++
 guix-qa-frontpage/server.scm       | 13 +++++++++++++
 guix-qa-frontpage/view/package.scm | 20 ++++++++++++++++++++
 4 files changed, 56 insertions(+)
 create mode 100644 guix-qa-frontpage/package.scm
 create mode 100644 guix-qa-frontpage/view/package.scm

diff --git a/Makefile.am b/Makefile.am
index 0bdf182..81b68fc 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -33,6 +33,7 @@ SOURCES =									\
   guix-qa-frontpage/database.scm						\
   guix-qa-frontpage/patchwork.scm						\
   guix-qa-frontpage/guix-data-service.scm					\
+  guix-qa-frontpage/package.scm						\
   guix-qa-frontpage/branch.scm							\
   guix-qa-frontpage/issue.scm							\
   guix-qa-frontpage/mumi.scm							\
@@ -44,6 +45,7 @@ SOURCES =									\
   guix-qa-frontpage/git-repository.scm						\
   guix-qa-frontpage/view/util.scm						\
   guix-qa-frontpage/view/home.scm						\
+  guix-qa-frontpage/view/package.scm						\
   guix-qa-frontpage/view/branches.scm						\
   guix-qa-frontpage/view/patches.scm						\
   guix-qa-frontpage/view/branch.scm						\
diff --git a/guix-qa-frontpage/package.scm b/guix-qa-frontpage/package.scm
new file mode 100644
index 0000000..9638ac4
--- /dev/null
+++ b/guix-qa-frontpage/package.scm
@@ -0,0 +1,21 @@
+(define-module (guix-qa-frontpage package)
+  #:use-module (srfi srfi-1)
+  #:use-module (guix-qa-frontpage guix-data-service)
+  #:export (package-data))
+
+(define (package-data name)
+  (let* ((revision (get-latest-processed-branch-revision "master"))
+         (package-versions
+          (vector->list
+           (assoc-ref
+            (guix-data-service-request
+             (string-append
+              "https://data.qa.guix.gnu.org/revision/" revision
+              "/package/" name ".json"))
+            "versions")))
+         (data
+          (guix-data-service-request
+           (string-append
+            "https://data.qa.guix.gnu.org/revision/" revision
+            "/package/" name "/" (last package-versions) ".json"))))
+    (peek data)))
diff --git a/guix-qa-frontpage/server.scm b/guix-qa-frontpage/server.scm
index 1216ed6..9677aea 100644
--- a/guix-qa-frontpage/server.scm
+++ b/guix-qa-frontpage/server.scm
@@ -51,6 +51,7 @@
   #:use-module (guix-qa-frontpage mumi)
   #:use-module (guix-qa-frontpage debbugs)
   #:use-module (guix-qa-frontpage branch)
+  #:use-module (guix-qa-frontpage package)
   #:use-module (guix-qa-frontpage issue)
   #:use-module (guix-qa-frontpage git-repository)
   #:use-module (guix-qa-frontpage manage-builds)
@@ -60,6 +61,7 @@
   #:use-module (guix-qa-frontpage view home)
   #:use-module (guix-qa-frontpage view patches)
   #:use-module (guix-qa-frontpage view branches)
+  #:use-module (guix-qa-frontpage view package)
   #:use-module (guix-qa-frontpage view branch)
   #:use-module (guix-qa-frontpage view issue)
   #:use-module (guix-qa-frontpage view reproducible-builds)
@@ -725,6 +727,17 @@ has no patches or has been closed.")
           (reproducible-builds-view package-reproducibility
                                     issue-data))))
 
+      (('GET "package" name)
+       (let ((package-data
+              (with-sqlite-cache
+               database
+               'package-data
+               package-data
+               #:ttl 3000
+               #:args (list name))))
+         (render-html
+          #:sxml (package-view package-data))))
+
       (('GET "README")
        (let ((filename (string-append doc-dir "/README.html")))
          (if (file-exists? filename)
diff --git a/guix-qa-frontpage/view/package.scm b/guix-qa-frontpage/view/package.scm
new file mode 100644
index 0000000..01d4744
--- /dev/null
+++ b/guix-qa-frontpage/view/package.scm
@@ -0,0 +1,20 @@
+(define-module (guix-qa-frontpage view package)
+  #:use-module (guix-qa-frontpage view util)
+  #:export (package-view))
+
+(define (package-view package-data)
+  (define name (assoc-ref package-data "name"))
+
+  (layout
+   #:title (string-append "Package: " name)
+   #:body
+   `((main
+      (dt "Synopsis")
+      (dd (raw ,(assoc-ref (assoc-ref package-data "synopsis") "html")))
+      (dt "Description")
+      (dd (raw ,(assoc-ref (assoc-ref package-data "description") "html")))
+      (dt "Home page")
+      (dd (a (@ (href ,(assoc-ref package-data "home-page")))
+             ,(assoc-ref package-data "home-page")))
+
+      (h1 "TODO More information to come")))))
-- 
cgit v1.2.3