diff options
author | Christopher Baines <mail@cbaines.net> | 2024-07-12 13:33:37 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2024-07-12 13:33:37 +0100 |
commit | a61c4baccd14fcc809ea677d5687e1036f0ee721 (patch) | |
tree | 22e6767d9f64bb1e401e7b7ed8a52f1f6b296528 /guix-data-service | |
parent | 9032079bdad7300cde5d3ee8daeb88ee381a1d6b (diff) | |
download | data-service-a61c4baccd14fcc809ea677d5687e1036f0ee721.tar data-service-a61c4baccd14fcc809ea677d5687e1036f0ee721.tar.gz |
Try and speed up large package derivation comparisions
Diffstat (limited to 'guix-data-service')
-rw-r--r-- | guix-data-service/comparison.scm | 18 | ||||
-rw-r--r-- | guix-data-service/web/compare/controller.scm | 3 | ||||
-rw-r--r-- | 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)) |