From 53652db9cab9604a96d82618c110a0d77b7dece5 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 22 Nov 2019 06:28:10 +0000
Subject: Add a page to render the channel news entries for a revision

---
 guix-data-service/web/revision/controller.scm | 46 +++++++++++++++++++++
 guix-data-service/web/revision/html.scm       | 58 ++++++++++++++++++++++++++-
 2 files changed, 103 insertions(+), 1 deletion(-)

diff --git a/guix-data-service/web/revision/controller.scm b/guix-data-service/web/revision/controller.scm
index 51d9212..040c948 100644
--- a/guix-data-service/web/revision/controller.scm
+++ b/guix-data-service/web/revision/controller.scm
@@ -28,6 +28,7 @@
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service web util)
   #:use-module (guix-data-service jobs load-new-guix-revision)
+  #:use-module (guix-data-service model channel-news)
   #:use-module (guix-data-service model package)
   #:use-module (guix-data-service model git-branch)
   #:use-module (guix-data-service model git-repository)
@@ -71,6 +72,19 @@
                                        (render-unknown-revision mime-types
                                                                 conn
                                                                 commit-hash)))
+    (('GET "revision" commit-hash "news")
+     (if (guix-commit-exists? conn commit-hash)
+         (let ((parsed-query-parameters
+                (parse-query-parameters
+                 request
+                 `((lang ,identity #:multi-value)))))
+           (render-revision-news mime-types
+                                 conn
+                                 commit-hash
+                                 parsed-query-parameters))
+         (render-unknown-revision mime-types
+                                  conn
+                                  commit-hash)))
     (('GET "revision" commit-hash "packages")
      (if (guix-commit-exists? conn commit-hash)
          (let ((parsed-query-parameters
@@ -215,6 +229,38 @@
                 #:header-text header-text)
         #:extra-headers http-headers-for-unchanging-content)))))
 
+(define (render-revision-news mime-types
+                              conn
+                              commit-hash
+                              query-parameters)
+  (if (any-invalid-query-parameters? query-parameters)
+      (case (most-appropriate-mime-type
+             '(application/json text/html)
+             mime-types)
+        ((application/json)
+         (render-json
+          `((error . "invalid query"))))
+        (else
+         (render-html
+          #:sxml (view-revision-news commit-hash
+                                     query-parameters
+                                     '()))))
+      (let ((news-entries
+             (select-channel-news-entries-contained-in-guix-revision conn
+                                                                     commit-hash)))
+        (case (most-appropriate-mime-type
+               '(application/json text/html)
+               mime-types)
+          ((application/json)
+           (render-json
+            '()))
+          (else
+           (render-html
+            #:sxml (view-revision-news commit-hash
+                                       query-parameters
+                                       news-entries)
+            #:extra-headers http-headers-for-unchanging-content))))))
+
 (define* (render-revision-packages mime-types
                                    conn
                                    commit-hash
diff --git a/guix-data-service/web/revision/html.scm b/guix-data-service/web/revision/html.scm
index f2458e2..f1e2dec 100644
--- a/guix-data-service/web/revision/html.scm
+++ b/guix-data-service/web/revision/html.scm
@@ -24,13 +24,69 @@
   #:use-module (guix-data-service web util)
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service web view html)
-  #:export (view-revision-package
+  #:export (view-revision-news
+            view-revision-package
             view-revision-package-and-version
             view-revision
             view-revision-packages
             view-revision-lint-warnings
             unknown-revision))
 
+(define* (view-revision-news commit-hash
+                             query-parameters
+                             news-entries)
+  (layout
+   #:body
+   `(,(header)
+     (div
+      (@ (class "container"))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 (a (@ (style "white-space: nowrap;")
+                  (href ,(string-append "/revision/" commit-hash)))
+               "Revision " (samp ,commit-hash)))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h1 "Channel News Entries")
+        ,@(map
+           (match-lambda
+             ((commit tag title-text body-text)
+              `(div
+                (h4 ,@(if (null? commit)
+                          '()
+                          `(("Commit: " (samp ,commit))))
+                    ,@(if (null? tag)
+                          '()
+                          `(("Tag: " ,tag))))
+                (table
+                 (@ (class "table"))
+                 (thead
+                  (tr
+                   (th (@ (class "col-sm-1")) "Language")
+                   (th (@ (class "col-sm-3")) "Title")
+                   (th (@ (class "col-sm-8")) "Body"))
+                  (tbody
+                   ,@(map (lambda (lang)
+                            `(tr
+                              (td ,lang)
+                              (td ,(stexi->shtml
+                                    (texi-fragment->stexi
+                                     (assoc-ref title-text lang))))
+                              (td ,
+                               (stexi->shtml
+                                (texi-fragment->stexi
+                                 (assoc-ref body-text lang))))))
+                          (sort
+                           (delete-duplicates
+                            (append (map car title-text)
+                                    (map car body-text)))
+                           string<?))))))))
+           news-entries)))))))
+
 (define* (view-revision-package revision-commit-hash
                                 name
                                 versions
-- 
cgit v1.2.3