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

Try and speed up large package derivation comparisions

Browse source
This commit is contained in:
Christopher Baines 2024-07-12 13:33:37 +01:00
parent 9032079bda
commit a61c4baccd
3 changed files with 21 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

18
guix-data-service/comparison.scm
View file

@ -635,19 +635,17 @@ ORDER BY coalesce(base_packages.name, target_packages.name) ASC, base_packages.v
package-data))) package-data)))
(define (package-derivation-data->names-and-versions package-data) (define (package-derivation-data->names-and-versions package-data)
(reverse (reverse!
(pair-fold (pair-fold
(lambda (pair result) (lambda (pair result)
(match pair (match pair
(((name . version)) ((p1 p2 rest ...)
(cons (cons name version) (if (and (string=? (car p1) (car p2))
result)) (string=? (cdr p1) (cdr p2)))
(((name1 . version1) (name2 . version2) rest ...)
(if (and (string=? name1 name2)
(string=? version1 version2))
result result
(cons (cons name1 version1) (cons p1 result)))
result))))) ((pair)
(cons pair result))))
'() '()
(map (match-lambda (map (match-lambda
((base-name base-version _ _ _ _ _ target-name target-version _ _ _ _ _) ((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) (or (hash-ref result key)
'()))) '())))
result)) result))
(make-hash-table) (make-hash-table 30000)
vhash)) vhash))
(define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash) (define (package-data-vhashes->new-packages base-packages-vhash target-packages-vhash)

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

@ -731,7 +731,8 @@
(target (target
. ((commit . ,target-commit))))) . ((commit . ,target-commit)))))
(derivation_changes (derivation_changes
. ,derivation-changes)))) . ,derivation-changes))
#:stream? #t))
(else (else
(letpar& ((systems (letpar& ((systems
(call-with-resource-from-pool (connection-pool) (call-with-resource-from-pool (connection-pool)

16
guix-data-service/web/render.scm
View file

@ -152,17 +152,23 @@
(sxml->html sxml port))))) (sxml->html sxml port)))))
(define* (render-json json #:key (extra-headers '()) (define* (render-json json #:key (extra-headers '())
(code 200)) (code 200)
stream?)
(list (build-response (list (build-response
#:code code #:code code
#:headers (append extra-headers #:headers (append extra-headers
'((content-type . (application/json '((content-type . (application/json
(charset . "utf-8"))) (charset . "utf-8")))
(vary . (accept))))) (vary . (accept)))))
(call-with-encoded-output-string (if stream?
"utf-8" (lambda (port)
(lambda (port) (set-port-encoding! port "utf-8")
(scm->json json port))))) (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 '()) (define* (render-text text #:key (extra-headers '())
(code 200)) (code 200))