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)))
(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)

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

@ -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)

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

@ -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)))))
(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)))))
(scm->json json port))))))
(define* (render-text text #:key (extra-headers '())
(code 200))