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

Attempt to reduce memory churn when processing package metadata

Browse source
This commit is contained in:
Christopher Baines 2024-12-22 11:05:38 +00:00
parent cdffef2397
commit d3c87fb1dc
3 changed files with 83 additions and 66 deletions
Download patch file Download diff file Expand all files Collapse all files

83
guix-data-service/model/package-metadata.scm
View file

@ -18,6 +18,7 @@
(define-module (guix-data-service model package-metadata) (define-module (guix-data-service model package-metadata)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-43)
#:use-module (ice-9 vlist) #:use-module (ice-9 vlist)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (squee) #:use-module (squee)
@ -275,8 +276,13 @@ WHERE packages.id IN (
(define (inferior-packages->package-metadata-ids conn (define (inferior-packages->package-metadata-ids conn
package-metadata package-metadata
license-set-ids) license-set-ids)
(define package-metadata-list (define (vector-zip . vecs)
(vector->list package-metadata)) (let ((result (make-vector (vector-length (first vecs)))))
(apply vector-map!
(lambda (i . vals)
(cdr vals))
(cons result vecs))
result))
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
@ -287,68 +293,71 @@ WHERE packages.id IN (
package_description_set_id package_description_set_id
package_synopsis_set_id) package_synopsis_set_id)
(list->vector (vector-zip
(zip (vector-map (match-lambda*
(map (match-lambda ((_ (home-page rest ...))
((home-page rest ...)
(if (string? home-page) (if (string? home-page)
home-page home-page
NULL))) NULL)))
package-metadata-list) package-metadata)
(with-time-logging "preparing location ids" (with-time-logging "preparing location ids"
(map (match-lambda (vector-map (match-lambda*
((_ location rest ...) ((_ (_ location rest ...))
(if location (if location
(location->location-id (location->location-id
conn conn
location) location)
NULL))) NULL)))
package-metadata-list)) package-metadata))
(vector->list license-set-ids) license-set-ids
(with-time-logging "preparing package description set ids" (with-time-logging "preparing package description set ids"
(map (lambda (package-description-ids) (vector-map (match-lambda*
(insert-and-return-id ((_ (_ _ package-description-data _))
conn (let ((package-description-ids
"package_description_sets"
'(description_ids)
(list (sort package-description-ids <))))
(with-time-logging "preparing package description ids"
(map (match-lambda
((_ _ package-description-data _)
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
"package_descriptions" "package_descriptions"
'(locale description) '(locale description)
(list->vector (let ((vec (list->vector package-description-data)))
(map (match-lambda (vector-map!
((locale . description) (match-lambda*
((_ (locale . description))
(list locale (list locale
;; \u0000 has appeared in package ;; \u0000 has appeared in package
;; descriptions (#71968), so strip it ;; descriptions (#71968), so strip it
;; out here to avoid PostgreSQL throwing ;; out here to avoid PostgreSQL throwing
;; an error ;; an error
(string-delete-null description)))) (string-delete-null description))))
package-description-data))))) vec)
package-metadata-list)))) vec))))
(with-time-logging "preparing package synopsis set ids"
(map (lambda (package-synopsis-ids)
(insert-and-return-id (insert-and-return-id
conn conn
"package_synopsis_sets" "package_description_sets"
'(synopsis_ids) '(description_ids)
(list (sort package-synopsis-ids <)))) (list (sort! package-description-ids <))))))
(map (match-lambda package-metadata))
((_ _ _ package-synopsis-data) (with-time-logging "preparing package synopsis set ids"
(vector-map (match-lambda*
((_ (_ _ _ package-synopsis-data))
(let ((package-synopsis-ids
(insert-missing-data-and-return-all-ids (insert-missing-data-and-return-all-ids
conn conn
"package_synopsis" "package_synopsis"
'(locale synopsis) '(locale synopsis)
(list->vector (let ((vec
(map (match-lambda (list->vector package-synopsis-data)))
((locale . synopsis) (vector-map!
(match-lambda*
((_ (locale . synopsis))
(list locale synopsis))) (list locale synopsis)))
package-synopsis-data))))) vec)
package-metadata-list))))))) vec))))
(insert-and-return-id
conn
"package_synopsis_sets"
'(synopsis_ids)
(list (sort! package-synopsis-ids <))))))
package-metadata)))))
(define (package-description-and-synopsis-locale-options-guix-revision conn (define (package-description-and-synopsis-locale-options-guix-revision conn
revision-id) revision-id)

6
tests/model-package-metadata.scm
View file

@ -48,6 +48,9 @@
(inferior-packages->license-id-lists (inferior-packages->license-id-lists
conn conn
'#((("License 1" '#((("License 1"
"https://gnu.org/licenses/test-1.html"
"https://example.com/why-license-1"))
(("License 1"
"https://gnu.org/licenses/test-1.html" "https://gnu.org/licenses/test-1.html"
"https://example.com/why-license-1")))))) "https://example.com/why-license-1"))))))
@ -74,7 +77,8 @@
conn conn
mock-package-metadata mock-package-metadata
(test-license-set-ids conn)) (test-license-set-ids conn))
(#(x) (number? x)))) (#(x y) (and (number? x)
(number? y)))))
#:always-rollback? #t)) #:always-rollback? #t))
(with-postgresql-transaction (with-postgresql-transaction

6
tests/model-package.scm
View file

@ -37,6 +37,9 @@
(inferior-packages->license-id-lists (inferior-packages->license-id-lists
conn conn
'#((("License 1" '#((("License 1"
"https://gnu.org/licenses/test-1.html"
"https://example.com/why-license-1"))
(("License 1"
"https://gnu.org/licenses/test-1.html" "https://gnu.org/licenses/test-1.html"
"https://example.com/why-license-1")))))) "https://example.com/why-license-1"))))))
@ -87,7 +90,8 @@
(map mock-inferior-package-version mock-inferior-packages) (map mock-inferior-package-version mock-inferior-packages)
(vector->list package-metadata-ids) (vector->list package-metadata-ids)
package-replacement-package-ids))) package-replacement-package-ids)))
(#(x) (number? x)))))) (#(x y) (and (number? x)
(number? y)))))))
#:always-rollback? #t) #:always-rollback? #t)
(with-postgresql-transaction (with-postgresql-transaction