Include news entries on the comparison page

3 files changed, 251 insertions, 9 deletions

diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index 9931358..535014e 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -4,6 +4,8 @@
   #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (squee)
+  #:use-module (json)
+  #:use-module (guix-data-service database)
   #:use-module (guix-data-service model utils)
   #:use-module (guix-data-service model derivation)
   #:export (derivation-differences-data
@@ -18,7 +20,9 @@
             package-data-version-changes
             package-data-derivation-changes
 
-            lint-warning-differences-data))
+            lint-warning-differences-data
+
+            channel-news-differences-data))
 
 (define (group-to-alist process lst)
   (fold (lambda (element result)
@@ -658,3 +662,108 @@ ORDER BY coalesce(base_lint_warnings.name, target_lint_warnings.name) ASC, base_
   (exec-query conn query
               (list base-guix-revision-id
                     target-guix-revision-id)))
+
+(define (channel-news-differences-data conn
+                                       base-guix-revision-id
+                                       target-guix-revision-id)
+  (define query
+    "
+WITH base_news_entries AS (
+  SELECT channel_news_entries.id,
+         channel_news_entries.commit,
+         channel_news_entries.tag,
+         (
+           SELECT JSON_AGG(ARRAY[lang,text])
+           FROM channel_news_entry_text
+           INNER JOIN channel_news_entry_titles
+             ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id
+             WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id
+         ) AS title_text,
+         (
+           SELECT JSON_AGG(ARRAY[lang,text])
+           FROM channel_news_entry_text
+           INNER JOIN channel_news_entry_bodies
+             ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id
+           WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id
+         ) AS body_text
+  FROM channel_news_entries
+  WHERE id IN (
+    SELECT channel_news_entry_id
+    FROM guix_revision_channel_news_entries
+    WHERE guix_revision_channel_news_entries.guix_revision_id = $1
+  )
+), target_news_entries AS (
+  SELECT channel_news_entries.id,
+         channel_news_entries.commit,
+         channel_news_entries.tag,
+         (
+           SELECT JSON_AGG(ARRAY[lang,text])
+           FROM channel_news_entry_text
+           INNER JOIN channel_news_entry_titles
+             ON channel_news_entry_text.id = channel_news_entry_titles.channel_news_entry_text_id
+             WHERE channel_news_entry_titles.channel_news_entry_id = channel_news_entries.id
+         ) AS title_text,
+         (
+           SELECT JSON_AGG(ARRAY[lang,text])
+           FROM channel_news_entry_text
+           INNER JOIN channel_news_entry_bodies
+             ON channel_news_entry_text.id = channel_news_entry_bodies.channel_news_entry_text_id
+           WHERE channel_news_entry_bodies.channel_news_entry_id = channel_news_entries.id
+         ) AS body_text
+  FROM channel_news_entries
+  WHERE id IN (
+    SELECT channel_news_entry_id
+    FROM guix_revision_channel_news_entries
+    WHERE guix_revision_channel_news_entries.guix_revision_id = $2
+  )
+)
+SELECT coalesce(
+         base_news_entries.commit,
+         target_news_entries.commit
+       ) AS commit,
+       coalesce(
+         base_news_entries.tag,
+         target_news_entries.tag
+       ) AS tag,
+       coalesce(
+         base_news_entries.title_text,
+         target_news_entries.title_text
+       ) AS title_text,
+       coalesce(
+         base_news_entries.body_text,
+         target_news_entries.body_text
+       ) AS body_text,
+       CASE
+         WHEN base_news_entries.id IS NULL THEN 'new'
+         WHEN target_news_entries.id IS NULL THEN 'removed'
+         ELSE 'changed'
+       END AS change
+FROM base_news_entries
+FULL OUTER JOIN target_news_entries
+  ON base_news_entries.commit = target_news_entries.commit
+WHERE (
+  base_news_entries.id IS NULL OR
+  target_news_entries.id IS NULL OR
+  base_news_entries.id != target_news_entries.id
+)")
+
+  (map
+   (match-lambda
+     ((commit tag title_text body_text change)
+      (list commit
+            tag
+            (map (match-lambda
+                   (#(lang text)
+                    (cons lang text)))
+                 (vector->list
+                  (json-string->scm title_text)))
+            (map (match-lambda
+                   (#(lang text)
+                    (cons lang text)))
+                 (vector->list
+                  (json-string->scm body_text)))
+            (string->symbol change))))
+   (exec-query-with-null-handling conn query
+                                  (peek (list base-guix-revision-id
+                                        target-guix-revision-id)))))
+
diff --git a/guix-data-service/web/compare/controller.scm b/guix-data-service/web/compare/controller.scm
index 16dcf39..dba1fd0 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -20,6 +20,10 @@
   #:use-module (srfi srfi-11)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
+  #:use-module (texinfo)
+  #:use-module (texinfo html)
+  #:use-module (texinfo plain-text)
+  #:use-module (guix-data-service web sxml)
   #:use-module (guix-data-service web util)
   #:use-module (guix-data-service web render)
   #:use-module (guix-data-service web query-parameters)
@@ -135,6 +139,14 @@
                                 parsed-query-parameters)))
     (_ #f)))
 
+(define (texinfo->variants-alist s)
+  (let ((stexi (texi-fragment->stexi s)))
+    `((source . ,s)
+      (html   . ,(with-output-to-string
+                   (lambda ()
+                     (sxml->html (stexi->shtml stexi)))))
+      (plain . ,(stexi->plain-text stexi)))))
+
 (define (render-compare mime-types
                         conn
                         query-parameters)
@@ -184,13 +196,45 @@
                    2
                    (lint-warning-differences-data conn
                                                   base-revision-id
-                                                  target-revision-id))))
+                                                  target-revision-id)))
+                 (channel-news-data
+                  (channel-news-differences-data conn
+                                                 base-revision-id
+                                                 target-revision-id)))
             (case (most-appropriate-mime-type
                    '(application/json text/html)
                    mime-types)
               ((application/json)
                (render-json
-                `((new-packages . ,(list->vector new-packages))
+                `((channel-news . ,(list->vector
+                                    (map
+                                     (match-lambda
+                                       ((commit tag title_text body_text change)
+                                        `(,@(if (null? commit)
+                                                '()
+                                                `((commit . ,commit)))
+                                          ,@(if (null? tag)
+                                                '()
+                                                `((tag . ,tag)))
+                                          (title-text
+                                           . ,(map
+                                               (match-lambda
+                                                 ((lang . text)
+                                                  (cons
+                                                   lang
+                                                   (texinfo->variants-alist text))))
+                                               title_text))
+                                          (body-text
+                                           . ,(map
+                                               (match-lambda
+                                                 ((lang . text)
+                                                  (cons
+                                                   lang
+                                                   (texinfo->variants-alist text))))
+                                               body_text))
+                                          (change . ,change))))
+                                     channel-news-data)))
+                  (new-packages . ,(list->vector new-packages))
                   (removed-packages . ,(list->vector removed-packages))
                   (version-changes . ,(list->vector
                                        (map
@@ -210,7 +254,8 @@
                                 new-packages
                                 removed-packages
                                 version-changes
-                                lint-warnings-data)
+                                lint-warnings-data
+                                channel-news-data)
                 #:extra-headers http-headers-for-unchanging-content))))))))
 
 (define (render-compare-by-datetime mime-types
@@ -272,13 +317,45 @@
                      2
                      (lint-warning-differences-data conn
                                                     base-revision-id
-                                                    target-revision-id))))
+                                                    target-revision-id)))
+                   (channel-news-data
+                    (channel-news-differences-data conn
+                                                   base-revision-id
+                                                   target-revision-id)))
               (case (most-appropriate-mime-type
                      '(application/json text/html)
                      mime-types)
                 ((application/json)
                  (render-json
-                  `((new-packages . ,(list->vector new-packages))
+                  `((channel-news . ,(list->vector
+                                      (map
+                                       (match-lambda
+                                         ((commit tag title_text body_text change)
+                                          `(,@(if (null? commit)
+                                                  '()
+                                                  `((commit . ,commit)))
+                                            ,@(if (null? tag)
+                                                  '()
+                                                  `((tag . ,tag)))
+                                            (title-text
+                                             . ,(map
+                                                 (match-lambda
+                                                   ((lang . text)
+                                                    (cons
+                                                     lang
+                                                     (texinfo->variants-alist text))))
+                                                 title_text))
+                                            (body-text
+                                             . ,(map
+                                                 (match-lambda
+                                                   ((lang . text)
+                                                    (cons
+                                                     lang
+                                                     (texinfo->variants-alist text))))
+                                                 body_text))
+                                            (change . ,change))))
+                                       channel-news-data)))
+                    (new-packages . ,(list->vector new-packages))
                     (removed-packages . ,(list->vector removed-packages))
                     (version-changes . ,(list->vector
                                          (map
@@ -300,7 +377,8 @@
                                   new-packages
                                   removed-packages
                                   version-changes
-                                  lint-warnings-data)
+                                  lint-warnings-data
+                                  channel-news-data)
                   #:extra-headers http-headers-for-unchanging-content)))))))))
 
 (define (render-compare/derivation mime-types
diff --git a/guix-data-service/web/compare/html.scm b/guix-data-service/web/compare/html.scm
index 26c63d6..88bd3db 100644
--- a/guix-data-service/web/compare/html.scm
+++ b/guix-data-service/web/compare/html.scm
@@ -19,6 +19,8 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
+  #:use-module (texinfo)
+  #:use-module (texinfo html)
   #:use-module (guix-data-service web query-parameters)
   #:use-module (guix-data-service web view html)
   #:export (compare
@@ -33,7 +35,8 @@
                  new-packages
                  removed-packages
                  version-changes
-                 lint-warnings-data)
+                 lint-warnings-data
+                 channel-news-data)
   (define base-commit
     (assq-ref query-parameters 'base_commit))
 
@@ -89,7 +92,59 @@
        (div
         (@ (class "col-sm-12"))
         (h3 (@ (style "clear: both;"))
-            "New packages")
+            "News entries")
+        ,(if (null? channel-news-data)
+             "No news entry changes"
+             (map
+              (match-lambda
+                ((commit tag title-text body-text change)
+                 `(div
+                   (h4 ,@(if (null? commit)
+                             '()
+                             `(("Commit: " (samp ,commit))))
+                       ,@(if (null? tag)
+                             '()
+                             `(("Tag: " ,tag))))
+                   (table
+                    (@ (class "table"))
+                    (thead
+                     (tr
+                      (th (@ (class "col-sm-1")) "")
+                      (th (@ (class "col-sm-1")) "Language")
+                      (th (@ (class "col-sm-3")) "Title")
+                      (th (@ (class "col-sm-7")) "Body"))
+                     (tbody
+                      ,@(let ((languages
+                               (sort
+                                (delete-duplicates
+                                 (append (map car title-text)
+                                         (map car body-text)))
+                                string<?)))
+                          (map (lambda (lang index)
+                                 `(tr
+                                   ,@(if (eq? index 0)
+                                         `((td (@ (rowspan ,(length languages)))
+                                               ,(case change
+                                                  ((new) "New")
+                                                  ((removed) "Removed")
+                                                  ((changed) "Changed"))))
+                                         '())
+                                   (td ,lang)
+                                   (td ,(stexi->shtml
+                                         (texi-fragment->stexi
+                                          (assoc-ref title-text lang))))
+                                   (td ,
+                                    (stexi->shtml
+                                     (texi-fragment->stexi
+                                      (assoc-ref body-text lang))))))
+                               languages
+                               (iota (length languages))))))))))
+              channel-news-data))))
+      (div
+       (@ (class "row"))
+       (div
+        (@ (class "col-sm-12"))
+        (h3 "New packages")
         ,(if (null? new-packages)
              '(p "No new packages")
              `(table