cbaines pushed a commit to branch master
in repository data-service.
commit 786908281610e9ae906e23af15a302b10dc000ab
Author: Christopher Baines <[email protected]>
AuthorDate: Thu Aug 8 13:30:30 2024 +0100
Parallelise inserting package derivation distribution counts
---
guix-data-service/jobs/load-new-guix-revision.scm | 25 +++++----
.../model/guix-revision-package-derivation.scm | 63 ++++++++++++----------
2 files changed, 51 insertions(+), 37 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index 1b13881..a8e056d 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -1856,8 +1856,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(loop (catch #t
(lambda ()
(stat:size (stat "/var/guix/db/db.sqlite-wal")))
- (lambda _ 0)))))
+ (lambda _ 0))))))
+ (define (process-system-and-target system target)
(with-time-logging
(simple-format #f "processing derivations for ~A" (cons system
target))
(let ((derivations-vector (make-vector packages-count)))
@@ -1913,7 +1914,18 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
guix-revision-id
package-derivation-ids-chunk)))
2000
- package-derivation-ids))))))
+ package-derivation-ids)))))
+
+ (with-resource-from-pool postgresql-connection-pool conn
+ (with-time-logging
+ (simple-format
+ #f "insert-guix-revision-package-derivation-distribution-counts
(~A ~A)"
+ system target)
+ (insert-guix-revision-package-derivation-distribution-counts
+ conn
+ guix-revision-id
+ system
+ (or target "")))))
(let ((process-system-and-target/fiberized
(fiberize process-system-and-target
@@ -1925,14 +1937,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(with-resource-from-pool inf-and-store-pool res
(match res
((inferior . inferior-store)
- (inferior-fetch-system-target-pairs inferior))))))
-
- (with-resource-from-pool postgresql-connection-pool conn
- (with-time-logging
- "insert-guix-revision-package-derivation-distribution-counts"
- (insert-guix-revision-package-derivation-distribution-counts
- conn
- guix-revision-id))))
+ (inferior-fetch-system-target-pairs inferior)))))))
(define (extract-and-store-system-tests)
(if skip-system-tests?
diff --git a/guix-data-service/model/guix-revision-package-derivation.scm
b/guix-data-service/model/guix-revision-package-derivation.scm
index 63c23e5..99a7079 100644
--- a/guix-data-service/model/guix-revision-package-derivation.scm
+++ b/guix-data-service/model/guix-revision-package-derivation.scm
@@ -20,6 +20,7 @@
#:use-module (ice-9 threads)
#:use-module (squee)
#:use-module (guix-data-service database)
+ #:use-module (guix-data-service model system)
#:export (insert-guix-revision-package-derivations
insert-guix-revision-package-derivation-distribution-counts
@@ -46,17 +47,9 @@
(define (insert-guix-revision-package-derivation-distribution-counts
conn
- guix-revision-id)
- (define system-ids-and-targets
- (exec-query
- conn
- "
-SELECT DISTINCT system_id, target
-FROM package_derivations
-INNER JOIN guix_revision_package_derivations
- ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
-WHERE revision_id = $1"
- (list guix-revision-id)))
+ guix-revision-id
+ system
+ target)
(define (get-count-for-next-level system-id target level-counts)
(define next-level
@@ -154,17 +147,16 @@ VALUES ($1, $2, $3, $4, $5)"
(number->string level)
(number->string count))))
- (for-each
- (match-lambda
- ((system-id target)
+ (define system-id
+ (number->string
+ (system->system-id conn system)))
- (let loop ((level-counts '()))
- (let ((level (length level-counts))
- (count (get-count-for-next-level system-id target level-counts)))
- (unless (= count 0)
- (insert-level-count system-id target level count)
- (loop (append level-counts (list count))))))))
- system-ids-and-targets))
+ (let loop ((level-counts '()))
+ (let ((level (length level-counts))
+ (count (get-count-for-next-level system-id target level-counts)))
+ (unless (= count 0)
+ (insert-level-count system-id target level count)
+ (loop (append level-counts (list count)))))))
(define (backfill-guix-revision-package-derivation-distribution-counts conn)
(define revision-ids
@@ -183,12 +175,29 @@ ORDER BY id DESC")))
(for-each
(lambda (revision-id)
(simple-format #t "backfilling
guix_revision_package_derivation_distribution_counts for revision ~A\n"
revision-id)
- (with-postgresql-transaction
- conn
- (lambda (conn)
- (insert-guix-revision-package-derivation-distribution-counts
- conn
- revision-id))))
+ (let ((system-ids-and-targets
+ (exec-query
+ conn
+ "
+SELECT DISTINCT system_id, target
+FROM package_derivations
+INNER JOIN guix_revision_package_derivations
+ ON package_derivations.id =
guix_revision_package_derivations.package_derivation_id
+WHERE revision_id = $1"
+ (list revision-id))))
+
+ (with-postgresql-transaction
+ conn
+ (lambda (conn)
+ (for-each
+ (match-lambda
+ ((system-id target)
+ (insert-guix-revision-package-derivation-distribution-counts
+ conn
+ revision-id
+ system-id
+ target)))
+ system-ids-and-targets)))))
revision-ids))
(define* (get-sql-to-select-package-and-related-derivations-for-revision
