diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-02-02 16:58:06 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-02-02 16:58:06 +0100 |
| commit | ac1a4cb1e28896631b8774a7b607f4f0bd6dc3c2 (patch) | |
| tree | 35b0b17bcd81fd8355703086a2d8d969692c5286 | |
| parent | 7ecb13e4032360c766da6b57d9baebf729181a57 (diff) | |
| download | data-service-ac1a4cb1e28896631b8774a7b607f4f0bd6dc3c2.tar data-service-ac1a4cb1e28896631b8774a7b607f4f0bd6dc3c2.tar.gz | |
Cleanup some with-time-logging
| -rw-r--r-- | guix-data-service/jobs/load-new-guix-revision.scm | 98 |
1 files changed, 52 insertions, 46 deletions
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm b/guix-data-service/jobs/load-new-guix-revision.scm index 1b47ea6..2737636 100644 --- a/guix-data-service/jobs/load-new-guix-revision.scm +++ b/guix-data-service/jobs/load-new-guix-revision.scm @@ -598,12 +598,10 @@ ;; with these that take up lots of memory (inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf) - (with-time-logging - (simple-format #f "getting derivations for ~A" (cons system target)) - (inferior-eval-with-store/non-blocking - inf - store - proc))) + (inferior-eval-with-store/non-blocking + inf + store + proc)) (define (sort-and-deduplicate-inferior-packages packages pkg-to-replacement-hash-table) @@ -1455,40 +1453,49 @@ (cons inferior-lint-checkers-data (and inferior-lint-checkers-data - (with-time-logging "fetching inferior lint warnings" - (par-map& - (match-lambda - ((checker-name _ network-dependent?) - (and (and (not network-dependent?) - ;; Running the derivation linter is - ;; currently infeasible - (not (eq? checker-name 'derivation))) - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (inferior-lint-warnings inferior - inferior-store - checker-name))))))) - inferior-lint-checkers-data)))))) + (par-map& + (match-lambda + ((checker-name _ network-dependent?) + (and (and (not network-dependent?) + ;; Running the derivation linter is + ;; currently infeasible + (not (eq? checker-name 'derivation))) + (with-resource-from-pool inf-and-store-pool res + (match res + ((inferior . inferior-store) + (inferior-lint-warnings inferior + inferior-store + checker-name))))))) + inferior-lint-checkers-data))))) (inferior-packages-system-and-target-to-derivations-alist - (with-time-logging "getting inferior derivations" - (par-map& - (match-lambda - ((system . target) - (with-resource-from-pool inf-and-store-pool res + (par-map& + (match-lambda + ((system . target) + (with-resource-from-pool inf-and-store-pool res + (with-time-logging + (simple-format #f "getting derivations for ~A" (cons system target)) (match res ((inferior . inferior-store) (ensure-gds-inferior-packages-defined! inferior) - (cons (cons system target) - (inferior-package-derivations inferior-store - inferior - system - target))))))) - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (inferior-fetch-system-target-pairs inferior))))))) + (let ((drvs + (inferior-package-derivations + inferior-store + inferior + system + target))) + + (vector-for-each + (lambda (_ drv) + (and=> drv add-temp-root/long-running-store)) + drvs) + + (cons (cons system target) + drvs)))))))) + (with-resource-from-pool inf-and-store-pool res + (match res + ((inferior . inferior-store) + (inferior-fetch-system-target-pairs inferior)))))) (inferior-system-tests (if skip-system-tests? (begin @@ -1502,17 +1509,16 @@ guix-source commit add-temp-root/long-running-store))))))) (packages-data - (with-time-logging "getting all inferior package data" - (with-resource-from-pool inf-and-store-pool res - (match res - ((inferior . inferior-store) - (with-time-logging "fetching inferior packages" - (let ((packages - pkg-to-replacement-hash-table - (inferior-packages-plus-replacements inferior))) - (all-inferior-packages-data inferior - packages - pkg-to-replacement-hash-table))))))))) + (with-resource-from-pool inf-and-store-pool res + (match res + ((inferior . inferior-store) + (with-time-logging "getting all inferior package data" + (let ((packages + pkg-to-replacement-hash-table + (inferior-packages-plus-replacements inferior))) + (all-inferior-packages-data inferior + packages + pkg-to-replacement-hash-table)))))))) (destroy-resource-pool inf-and-store-pool) |