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

Stream the /compare.json response

Browse source 
Since this could be quite large.
This commit is contained in:
Christopher Baines 2025-07-04 10:36:26 +01:00
parent 62cf3ff7cb
commit a5e9e2f6a5
1 changed files with 123 additions and 84 deletions
Download patch file Download diff file Expand all files Collapse all files

73
guix-data-service/web/compare/controller.scm
View file

@ -26,6 +26,8 @@
#:use-module (texinfo html)
#:use-module (texinfo plain-text)
#:use-module (json)
#:use-module (fibers)
#:use-module (knots promise)
#:use-module (knots parallelism)
#:use-module (knots resource-pool)
#:use-module (guix-data-service utils)
@ -307,28 +309,46 @@
(version-changes
(package-data-version-changes base-packages-vhash
target-packages-vhash)))
(fibers-let ((lint-warnings-data
(let ((lint-warnings-data-promise
(fibers-delay
(lambda ()
(with-resource-from-pool (connection-pool) conn
(group-list-by-first-n-fields
2
(lint-warning-differences-data conn
base-revision-id
target-revision-id
locale))))
(channel-news-data
locale))))))
(channel-news-data-promise
(fibers-delay
(lambda ()
(with-resource-from-pool (connection-pool) conn
(channel-news-differences-data conn
base-revision-id
target-revision-id))))
target-revision-id))))))
;; TODO Make this neater
(spawn-fiber
(lambda ()
(fibers-force lint-warnings-data-promise))
#:parallel? #t)
(spawn-fiber
(lambda ()
(fibers-force channel-news-data-promise))
#:parallel? #t)
(case (most-appropriate-mime-type
'(application/json text/html)
mime-types)
((application/json)
(render-json
(lambda (port)
(scm-alist->streaming-json
`((base-commit . ,(assq-ref query-parameters 'base_commit))
(target-commit . ,(assq-ref query-parameters 'target_commit))
(channel-news . ,(list->vector
(map
(channel-news
.
,(lambda (port)
(list->json-array
(match-lambda
((commit tag title_text body_text change)
`(,@(if (null? commit)
@ -354,19 +374,35 @@
(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
(fibers-force channel-news-data-promise)
port)))
(new-packages
.
,(lambda (port)
(list->json-array
identity
new-packages
port)))
(removed-packages
.
,(lambda (port)
(list->json-array
identity
removed-packages
port)))
(version-changes
. ,(lambda (port)
(list->json-array
(match-lambda
((name data ...)
`((name . ,name)
,@data)))
version-changes)))
version-changes
port)))
(lint_warnings
. ,(list->vector
(map
.
,(lambda (port)
(list->json-array
(match-lambda
(((package-name package-version)
. warnings)
@ -397,7 +433,10 @@
(column . ,(string->number
column-number)))))))
warnings))))))
lint-warnings-data))))
(fibers-force lint-warnings-data-promise)
port))))
port))
#:stream? #t
#:extra-headers http-headers-for-unchanging-content))
(else
(fibers-let ((lint-warnings-locale-options
@ -422,9 +461,9 @@
new-packages
removed-packages
version-changes
lint-warnings-data
(fibers-force lint-warnings-data-promise)
lint-warnings-locale-options
channel-news-data)
(fibers-force channel-news-data-promise))
#:extra-headers http-headers-for-unchanging-content))))))))))
(define (render-compare-by-datetime mime-types