From 23f60a6bbb923a9510d95250b4a1626cb8a84b7f Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Wed, 20 Nov 2019 23:03:50 +0000
Subject: Include news entries on the comparison page
---
guix-data-service/comparison.scm | 111 ++++++++++++++++++++++++++-
guix-data-service/web/compare/controller.scm | 90 ++++++++++++++++++++--
guix-data-service/web/compare/html.scm | 59 +++++++++++++-
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
--
cgit v1.2.3