cbaines pushed a commit to branch master
in repository data-service.
commit a61c4baccd14fcc809ea677d5687e1036f0ee721
Author: Christopher Baines <[email protected]>
AuthorDate: Fri Jul 12 13:33:37 2024 +0100
Try and speed up large package derivation comparisions
---
guix-data-service/comparison.scm | 18 ++++++++----------
guix-data-service/web/compare/controller.scm | 3 ++-
guix-data-service/web/render.scm | 16 +++++++++++-----
3 files changed, 21 insertions(+), 16 deletions(-)
diff --git a/guix-data-service/comparison.scm b/guix-data-service/comparison.scm
index 58a9e76..1559ac8 100644
--- a/guix-data-service/comparison.scm
+++ b/guix-data-service/comparison.scm
@@ -635,19 +635,17 @@ ORDER BY coalesce(base_packages.name,
target_packages.name) ASC, base_packages.v
package-data)))
(define (package-derivation-data->names-and-versions package-data)
- (reverse
+ (reverse!
(pair-fold
(lambda (pair result)
(match pair
- (((name . version))
- (cons (cons name version)
- result))
- (((name1 . version1) (name2 . version2) rest ...)
- (if (and (string=? name1 name2)
- (string=? version1 version2))
+ ((p1 p2 rest ...)
+ (if (and (string=? (car p1) (car p2))
+ (string=? (cdr p1) (cdr p2)))
result
- (cons (cons name1 version1)
- result)))))
+ (cons p1 result)))
+ ((pair)
+ (cons pair result))))
'()
(map (match-lambda
((base-name base-version _ _ _ _ _ target-name target-version _ _ _
_ _)
@@ -705,7 +703,7 @@ ORDER BY coalesce(base_packages.name, target_packages.name)
ASC, base_packages.v
(or (hash-ref result key)
'())))
result))
- (make-hash-table)
+ (make-hash-table 30000)
vhash))
(define (package-data-vhashes->new-packages base-packages-vhash
target-packages-vhash)
diff --git a/guix-data-service/web/compare/controller.scm
b/guix-data-service/web/compare/controller.scm
index 242760b..901b4f9 100644
--- a/guix-data-service/web/compare/controller.scm
+++ b/guix-data-service/web/compare/controller.scm
@@ -731,7 +731,8 @@
(target
. ((commit . ,target-commit)))))
(derivation_changes
- . ,derivation-changes))))
+ . ,derivation-changes))
+ #:stream? #t))
(else
(letpar& ((systems
(call-with-resource-from-pool (connection-pool)
diff --git a/guix-data-service/web/render.scm b/guix-data-service/web/render.scm
index 744c66c..1ec47ac 100644
--- a/guix-data-service/web/render.scm
+++ b/guix-data-service/web/render.scm
@@ -152,17 +152,23 @@
(sxml->html sxml port)))))
(define* (render-json json #:key (extra-headers '())
- (code 200))
+ (code 200)
+ stream?)
(list (build-response
#:code code
#:headers (append extra-headers
'((content-type . (application/json
(charset . "utf-8")))
(vary . (accept)))))
- (call-with-encoded-output-string
- "utf-8"
- (lambda (port)
- (scm->json json port)))))
+ (if stream?
+ (lambda (port)
+ (set-port-encoding! port "utf-8")
+ (setvbuf port 'block (expt 2 20))
+ (scm->json json port))
+ (call-with-encoded-output-string
+ "utf-8"
+ (lambda (port)
+ (scm->json json port))))))
(define* (render-text text #:key (extra-headers '())
(code 200))
