diff options
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 94 |
1 files changed, 51 insertions, 43 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 2743519..d5c1be7 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -196,54 +196,62 @@ (lambda () (deduplicate-inferior-packages (inferior-packages inf))))) - (package-license-set-ids - (log-time "fetching inferior package license metadata" - (lambda () - (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)))) - (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))) (inferior-data-4-tuples (log-time "getting inferior derivations" (lambda () (all-inferior-package-derivations store inf packages))))) - (simple-format - #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))) - (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))) - - (insert-package-derivations conn - flat-package-ids-systems-and-targets - derivation-ids)))) + (define loading-inferior-data + (record-start-time "critical region fetching and loading inferior data")) + + (let* ((package-license-set-ids + (log-time "fetching inferior package license metadata" + (lambda () + (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))))) + + (simple-format + #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) ((@@ (guix inferior) inferior-package-field) |