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

Move around some of the load new revision code

Browse source 
To better separate the code that needs to happen after a lock has been
acquired to allow concurrently loading revisions without concurrent insertion
issues.
This commit is contained in:
Christopher Baines 2019-07-07 21:59:36 +01:00
parent 2ea78cff47
commit f2d28b4def
1 changed files with 68 additions and 67 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -304,67 +304,55 @@
(string<? a-name (string<? a-name
b-name))))))) b-name)))))))
(define (inferior-guix->package-derivation-ids store conn inf) (define (packages-and-inferior-data->package-derivation-ids conn inf
(let* ((packages (log-time "fetching inferior packages" packages
(lambda () inferior-data-4-tuples)
(deduplicate-inferior-packages (let* ((package-license-set-ids
(inferior-packages inf))))) (log-time "fetching inferior package license metadata"
(inferior-data-4-tuples
(log-time "getting inferior derivations"
(lambda () (lambda ()
(all-inferior-package-derivations store inf packages))))) (inferior-packages->license-set-ids conn inf
packages))))
(packages-metadata-ids
(log-time "fetching inferior package metadata"
(lambda ()
(inferior-packages->package-metadata-ids
conn packages package-license-set-ids))))
(package-ids
(log-time "getting package-ids"
(lambda ()
(inferior-packages->package-ids
conn packages packages-metadata-ids)))))
(define loading-inferior-data (simple-format
(record-start-time "critical region fetching and loading inferior data")) #t "debug: finished loading information from inferior\n")
(close-inferior inf)
(let* ((package-license-set-ids (let* ((derivation-ids
(log-time "fetching inferior package license metadata" (derivation-file-names->derivation-ids
(lambda () conn
(inferior-packages->license-set-ids conn inf (map fourth inferior-data-4-tuples)))
packages)))) (inferior-package-id->package-id-hash-table
(packages-metadata-ids (alist->hashq-table
(log-time "fetching inferior package metadata" (map (lambda (package package-id)
(lambda () (cons (inferior-package-id package)
(inferior-packages->package-metadata-ids package-id))
conn packages package-license-set-ids)))) packages
(package-ids package-ids)))
(log-time "getting package-ids" (flat-package-ids-systems-and-targets
(lambda () (map
(inferior-packages->package-ids (match-lambda
conn packages packages-metadata-ids))))) ((inferior-package-id system target derivation-file-name)
(list (hashq-ref inferior-package-id->package-id-hash-table
inferior-package-id)
system
target)))
inferior-data-4-tuples))
(package-derivation-ids
(insert-package-derivations conn
flat-package-ids-systems-and-targets
derivation-ids)))
(simple-format package-derivation-ids)))
#t "debug: finished loading information from inferior\n")
(close-inferior inf)
(let* ((derivation-ids
(derivation-file-names->derivation-ids
conn
(map fourth inferior-data-4-tuples)))
(inferior-package-id->package-id-hash-table
(alist->hashq-table
(map (lambda (package package-id)
(cons (inferior-package-id package)
package-id))
packages
package-ids)))
(flat-package-ids-systems-and-targets
(map
(match-lambda
((inferior-package-id system target derivation-file-name)
(list (hashq-ref inferior-package-id->package-id-hash-table
inferior-package-id)
system
target)))
inferior-data-4-tuples))
(package-derivation-ids
(insert-package-derivations conn
flat-package-ids-systems-and-targets
derivation-ids)))
(record-end-time loading-inferior-data)
package-derivation-ids))))
(define (inferior-package-transitive-supported-systems package) (define (inferior-package-transitive-supported-systems package)
((@@ (guix inferior) inferior-package-field) ((@@ (guix inferior) inferior-package-field)
@ -538,18 +526,31 @@
(catch (catch
#t #t
(lambda () (lambda ()
(let* ((package-derivation-ids (let* ((packages
(inferior-guix->package-derivation-ids store conn inf)) (log-time
(guix-revision-id "fetching inferior packages"
(insert-guix-revision conn git-repository-id commit store-path))) (lambda ()
(deduplicate-inferior-packages
(inferior-packages inf)))))
(inferior-data-4-tuples
(log-time
"getting inferior derivations"
(lambda ()
(all-inferior-package-derivations store inf packages)))))
(insert-guix-revision-package-derivations conn (let* ((package-derivation-ids
guix-revision-id (packages-and-inferior-data->package-derivation-ids
package-derivation-ids) conn inf packages inferior-data-4-tuples))
(guix-revision-id
(insert-guix-revision conn git-repository-id commit store-path)))
(simple-format (insert-guix-revision-package-derivations conn
#t "Successfully loaded ~A package/derivation pairs\n" guix-revision-id
(length package-derivation-ids))) package-derivation-ids)
(simple-format
#t "Successfully loaded ~A package/derivation pairs\n"
(length package-derivation-ids))))
#t) #t)
(lambda (key . args) (lambda (key . args)
(simple-format (current-error-port) (simple-format (current-error-port)