Include news entries on the comparison page

This commit is contained in:
Christopher Baines 2019-11-20 23:03:50 +00:00
parent 6c5370f9c5
commit 23f60a6bbb
3 changed files with 251 additions and 9 deletions

View file

@ -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)))))

View file

@ -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

View file

@ -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