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

Make some sweeping changes to loading new revisions

Browse source 
Move in the direction of being able to run multiple inferior REPLs, and use
some vectors rather than lists in places (maybe this is more efficient).
This commit is contained in:
Christopher Baines 2023-11-01 21:08:22 +00:00
parent 89782b3449
commit f5acc60288
6 changed files with 500 additions and 520 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -17,6 +17,7 @@
(define-module (guix-data-service model derivation)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-43)
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
@ -1545,7 +1546,8 @@ LIMIT $1"
(update-derivation-ids-hash-table! conn
derivation-ids-hash-table
input-derivation-file-names)
(list->vector
input-derivation-file-names))
(simple-format
#t
"debug: ensure-input-derivations-exist: checking for missing input derivations\n")
@ -1743,18 +1745,20 @@ WHERE " criteria ";"))
(define (update-derivation-ids-hash-table! conn
derivation-ids-hash-table
file-names)
(define file-names-count (length file-names))
(define file-names-count (vector-length file-names))
(simple-format #t "debug: update-derivation-ids-hash-table!: ~A file-names\n"
file-names-count)
(let ((missing-file-names
(fold (lambda (file-name result)
(if (hash-ref derivation-ids-hash-table
file-name)
result
(cons file-name result)))
'()
file-names)))
(vector-fold
(lambda (_ result file-name)
(if (and file-name
(hash-ref derivation-ids-hash-table
file-name))
result
(cons file-name result)))
'()
file-names)))
(simple-format
#t "debug: update-derivation-ids-hash-table!: lookup ~A file-names, ~A not cached\n"
@ -1773,6 +1777,9 @@ WHERE " criteria ";"))
(chunk! missing-file-names 1000)))))
(define (derivation-file-names->derivation-ids conn derivation-file-names)
(define derivations-count
(vector-length derivation-file-names))
(define (insert-source-files-missing-nars derivation-ids)
(define (derivation-ids->next-related-derivation-ids! ids seen-ids)
(delete-duplicates/sort!
@ -1862,10 +1869,9 @@ INNER JOIN derivation_source_files
next-related-derivation-ids
seen-ids)))))))
(if (null? derivation-file-names)
'()
(let* ((derivations-count (length derivation-file-names))
(derivation-ids-hash-table (make-hash-table
(if (= 0 derivations-count)
#()
(let* ((derivation-ids-hash-table (make-hash-table
;; Account for more derivations in
;; the graph
(* 2 derivations-count))))
@ -1879,10 +1885,16 @@ INNER JOIN derivation_source_files
(let ((missing-derivation-filenames
(deduplicate-strings
(filter (lambda (derivation-file-name)
(not (hash-ref derivation-ids-hash-table
derivation-file-name)))
derivation-file-names))))
(vector-fold
(lambda (_ result derivation-file-name)
(if (not derivation-file-name)
result
(if (hash-ref derivation-ids-hash-table
derivation-file-name)
result
(cons derivation-file-name result))))
'()
derivation-file-names))))
(chunk-for-each!
(lambda (missing-derivation-filenames-chunk)
@ -1907,14 +1919,25 @@ INNER JOIN derivation_source_files
missing-derivation-filenames)
(let ((all-ids
(map (lambda (derivation-file-name)
(vector-map
(lambda (_ derivation-file-name)
(if derivation-file-name
(or (hash-ref derivation-ids-hash-table
derivation-file-name)
(error "missing derivation id")))
derivation-file-names)))
(error "missing derivation id"))
#f))
derivation-file-names)))
(with-time-logging "insert-source-files-missing-nars"
(insert-source-files-missing-nars all-ids))
(insert-source-files-missing-nars
;; TODO Avoid this conversion
(vector-fold
(lambda (_ result x)
(if x
(cons x result)
result))
'()
all-ids)))
all-ids)))))