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

Try to better chunk derivations for insertion

Browse source
This commit is contained in:
Christopher Baines 2025-07-08 11:10:12 +01:00
parent 734ee541be
commit 1728494363
1 changed files with 80 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

80
guix-data-service/jobs/load-new-guix-revision.scm
View file

@ -1224,17 +1224,40 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
'() '()
derivations))) derivations)))
(unless (null? input-derivations) (unless (null? input-derivations)
;; Ensure all the input derivations exist (let loop ((chunk '())
(chunk-for-each! (count 0)
(lambda (chunk) (rest input-derivations))
(if (null? rest)
(unless (null? chunk)
(insert-missing-derivations (insert-missing-derivations
postgresql-connection-pool postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
derivation-ids-hash-table derivation-ids-hash-table
chunk chunk
#:log-tag log-tag)) #:log-tag log-tag))
1000 (if (= count 1000)
input-derivations))))) (begin
(simple-format #t "debug: inserting ~A input derivations\n"
count)
(insert-missing-derivations
postgresql-connection-pool
call-with-utility-thread
derivation-ids-hash-table
chunk
#:log-tag log-tag)
(loop '()
0
rest))
(let ((drv (car rest)))
(if (hash-ref derivation-ids-hash-table
(derivation-file-name
drv))
(loop chunk
count
(cdr rest))
(loop (cons drv chunk)
(+ 1 count)
(cdr rest)))))))))))
(let ((derivations (let ((derivations
derivation-ids derivation-ids
@ -1739,6 +1762,38 @@ WHERE builder != 'builtin:download'
(for-each fix-derivation (for-each fix-derivation
broken-derivations)))) broken-derivations))))
(define (flatten-derivation-graph derivations
derivation-ids-hash-table)
(define seen-hash-table
(make-hash-table))
(define (flatten-inputs derivation result)
(fold
(lambda (input result)
(let ((drv (derivation-input-derivation input)))
(if (or (hash-ref derivation-ids-hash-table
(derivation-file-name drv))
(hash-ref seen-hash-table
drv))
result
(begin
(hash-set! seen-hash-table drv #t)
(cons drv
(flatten-inputs drv result))))))
result
(derivation-inputs derivation)))
(reverse!
(fold
(lambda (derivation result)
(let ((flat-inputs
(flatten-inputs derivation
result)))
(cons derivation
flat-inputs)))
'()
derivations)))
(define* (derivation-file-names->derivation-ids postgresql-connection-pool (define* (derivation-file-names->derivation-ids postgresql-connection-pool
call-with-utility-thread call-with-utility-thread
read-derivations/serialised read-derivations/serialised
@ -1777,13 +1832,22 @@ WHERE builder != 'builtin:download'
(let ((chunk-counter 0)) (let ((chunk-counter 0))
(chunk-for-each! (chunk-for-each!
(lambda (missing-derivation-file-names-chunk) (lambda (missing-derivation-file-names-chunk)
(let ((missing-derivations-chunk
(read-derivations/serialised
missing-derivation-file-names-chunk)))
(simple-format (simple-format
#t "debug: derivation-file-names->derivation-ids: processing chunk ~A (~A)\n" #t "debug: derivation-file-names->derivation-ids: processing chunk ~A (~A)\n"
chunk-counter chunk-counter
log-tag) log-tag)
(let* ((missing-derivations-chunk
(read-derivations/serialised
missing-derivation-file-names-chunk))
(flat-missing-derivations
(with-time-logging "flattening missing derivations"
(flatten-derivation-graph
missing-derivations-chunk
derivation-ids-hash-table))))
(simple-format
#t "debug: derivation-file-names->derivation-ids: processing ~A flat missing derivations (~A)\n"
(length flat-missing-derivations)
log-tag)
(set! chunk-counter (+ 1 chunk-counter)) (set! chunk-counter (+ 1 chunk-counter))
(insert-missing-derivations postgresql-connection-pool (insert-missing-derivations postgresql-connection-pool
call-with-utility-thread call-with-utility-thread