cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Include news entries on the comparison page

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

90
guix-data-service/web/compare/controller.scm
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

59
guix-data-service/web/compare/html.scm
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