Cache the derivations that weren't deleted

When deleting derivations, as I think this might reduce the number of queries.
This commit is contained in:
Christopher Baines 2024-06-20 15:47:21 +01:00
parent 5e88a98c47
commit 530f58b59c

View file

@ -552,6 +552,7 @@ DELETE FROM derivations WHERE id = $1"
1)))
(define deleted-count 0)
(define ignored-derivation-ids (make-hash-table))
(define channel (make-channel))
(define (delete-batch conn)
@ -589,7 +590,8 @@ WHERE NOT EXISTS (
(set! deleted-count 0)
(for-each
(lambda (derivation-id)
(put-message channel derivation-id))
(unless (hash-ref ignored-derivation-ids derivation-id)
(put-message channel derivation-id)))
derivations))
(simple-format (current-error-port)
@ -636,6 +638,11 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
0))))
(when (= 0 val)
(hash-set! ignored-derivation-ids
derivation-id
#t))
;; This is safe as all fibers are in the same
;; thread and cooperative.
(set! deleted-count
@ -654,13 +661,18 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
(let ((batch-deleted-count (delete-batch conn)))
(if (eq? 0 batch-deleted-count)
(begin
(with-time-logging
"Deleting unused derivation_source_files entries"
(delete-unreferenced-derivations-source-files conn))
(simple-format
(current-output-port)
"Finished deleting derivations, deleted ~A in total\n"
total-deleted))
(hash-clear! ignored-derivation-ids)
(let ((batch-deleted-count (delete-batch conn)))
(if (= 0 batch-deleted-count)
(begin
(with-time-logging
"Deleting unused derivation_source_files entries"
(delete-unreferenced-derivations-source-files conn))
(simple-format
(current-output-port)
"Finished deleting derivations, deleted ~A in total\n"
total-deleted))
(loop (+ total-deleted batch-deleted-count)))))
(loop (+ total-deleted batch-deleted-count))))))))
#:hz 0
#:parallelism 1))