Stream the /compare.json response

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

View file

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