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

Add more time logging in to insert-missing-derivations

Browse source
This commit is contained in:
Christopher Baines 2024-07-16 16:13:17 +01:00
parent 7da355b034
commit bbbcea8ff6
1 changed files with 58 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

116
guix-data-service/model/derivation.scm
View file

@ -1623,70 +1623,70 @@ LIMIT $1"
" RETURNING id" " RETURNING id"
";")) ";"))
(simple-format (with-time-logging
#t "debug: insert-missing-derivations: inserting ~A derivations\n" (simple-format
(length derivations)) #f "insert-missing-derivations: inserting ~A derivations"
(let ((derivation-ids (length derivations))
(append-map (let ((derivation-ids
(lambda (chunk) (append-map
(map (lambda (result) (lambda (chunk)
(string->number (car result))) (map (lambda (result)
(exec-query conn (insert-into-derivations chunk)))) (string->number (car result)))
(chunk derivations 500)))) (exec-query conn (insert-into-derivations chunk))))
(chunk derivations 500))))
(simple-format (with-time-logging
#t "debug: insert-missing-derivations: updating hash table\n") "insert-missing-derivations: updating hash table"
(for-each (lambda (derivation derivation-id) (for-each (lambda (derivation derivation-id)
(hash-set! derivation-ids-hash-table (hash-set! derivation-ids-hash-table
(derivation-file-name derivation) (derivation-file-name derivation)
derivation-id)) derivation-id))
derivations derivations
derivation-ids) derivation-ids))
(simple-format (with-time-logging
#t "debug: insert-missing-derivations: inserting outputs\n") "insert-missing-derivations: inserting outputs"
(for-each (lambda (derivation-id derivation) (for-each (lambda (derivation-id derivation)
(insert-derivation-outputs conn (insert-derivation-outputs conn
derivation-id derivation-id
(derivation-outputs derivation))) (derivation-outputs derivation)))
derivation-ids derivation-ids
derivations) derivations))
(simple-format (with-time-logging
#t "debug: insert-missing-derivations: inserting sources\n") "insert-missing-derivations: inserting sources"
(for-each (lambda (derivation-id derivation) (for-each (lambda (derivation-id derivation)
(let ((sources (derivation-sources derivation))) (let ((sources (derivation-sources derivation)))
(unless (null? sources) (unless (null? sources)
(let ((sources-ids (let ((sources-ids
(insert-derivation-sources conn (insert-derivation-sources conn
derivation-id derivation-id
sources))) sources)))
(map (lambda (id source-file) (map (lambda (id source-file)
(insert-derivation-source-file-nar conn (insert-derivation-source-file-nar conn
id id
source-file)) source-file))
sources-ids sources-ids
sources))))) sources)))))
derivation-ids derivation-ids
derivations) derivations))
(simple-format (with-time-logging
#t "debug: insert-missing-derivations: ensure-input-derivations-exist\n") "insert-missing-derivations: ensure-input-derivations-exist"
(ensure-input-derivations-exist (deduplicate-strings
(map derivation-input-path
(append-map derivation-inputs
derivations)))))
(ensure-input-derivations-exist (deduplicate-strings (with-time-logging
(map derivation-input-path (simple-format
(append-map derivation-inputs #f "insert-missing-derivations: inserting inputs for ~A derivations"
derivations)))) (length derivations))
(insert-derivation-inputs conn
derivation-ids
derivations))
(with-time-logging derivation-ids)))
(simple-format
#f "insert-missing-derivations: inserting inputs for ~A derivations"
(length derivations))
(insert-derivation-inputs conn
derivation-ids
derivations))
derivation-ids))
(define (select-derivations-by-id conn ids) (define (select-derivations-by-id conn ids)
(define query (define query