Attempt to reduce memory churn when processing package metadata

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

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)
package-metadata-list) (with-time-logging "preparing location ids"
(with-time-logging "preparing location ids" (vector-map (match-lambda*
(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))
package-metadata-list)) license-set-ids
(vector->list license-set-ids) (with-time-logging "preparing package description set ids"
(with-time-logging "preparing package description set ids" (vector-map (match-lambda*
(map (lambda (package-description-ids) ((_ (_ _ package-description-data _))
(insert-and-return-id (let ((package-description-ids
conn (insert-missing-data-and-return-all-ids
"package_description_sets" conn
'(description_ids) "package_descriptions"
(list (sort package-description-ids <)))) '(locale description)
(with-time-logging "preparing package description ids" (let ((vec (list->vector package-description-data)))
(map (match-lambda (vector-map!
((_ _ package-description-data _) (match-lambda*
(insert-missing-data-and-return-all-ids ((_ (locale . description))
conn (list locale
"package_descriptions" ;; \u0000 has appeared in package
'(locale description) ;; descriptions (#71968), so strip it
(list->vector ;; out here to avoid PostgreSQL throwing
(map (match-lambda ;; an error
((locale . description) (string-delete-null description))))
(list locale vec)
;; \u0000 has appeared in package vec))))
;; descriptions (#71968), so strip it (insert-and-return-id
;; out here to avoid PostgreSQL throwing conn
;; an error "package_description_sets"
(string-delete-null description)))) '(description_ids)
package-description-data))))) (list (sort! package-description-ids <))))))
package-metadata-list)))) package-metadata))
(with-time-logging "preparing package synopsis set ids" (with-time-logging "preparing package synopsis set ids"
(map (lambda (package-synopsis-ids) (vector-map (match-lambda*
(insert-and-return-id ((_ (_ _ _ package-synopsis-data))
conn (let ((package-synopsis-ids
"package_synopsis_sets" (insert-missing-data-and-return-all-ids
'(synopsis_ids) conn
(list (sort package-synopsis-ids <)))) "package_synopsis"
(map (match-lambda '(locale synopsis)
((_ _ _ package-synopsis-data) (let ((vec
(insert-missing-data-and-return-all-ids (list->vector package-synopsis-data)))
conn (vector-map!
"package_synopsis" (match-lambda*
'(locale synopsis) ((_ (locale . synopsis))
(list->vector (list locale synopsis)))
(map (match-lambda vec)
((locale . synopsis) vec))))
(list locale synopsis))) (insert-and-return-id
package-synopsis-data))))) conn
package-metadata-list))))))) "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)

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

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