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

Cleanup some with-time-logging

Browse source
This commit is contained in:
Christopher Baines 2024-02-02 16:58:06 +01:00
parent 7ecb13e403
commit ac1a4cb1e2
1 changed files with 52 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -598,12 +598,10 @@
;; with these that take up lots of memory ;; with these that take up lots of memory
(inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf) (inferior-eval '(when (defined? '%store-table) (hash-clear! %store-table)) inf)
(with-time-logging (inferior-eval-with-store/non-blocking
(simple-format #f "getting derivations for ~A" (cons system target)) inf
(inferior-eval-with-store/non-blocking store
inf proc))
store
proc)))
(define (sort-and-deduplicate-inferior-packages packages (define (sort-and-deduplicate-inferior-packages packages
pkg-to-replacement-hash-table) pkg-to-replacement-hash-table)
@ -1455,40 +1453,49 @@
(cons (cons
inferior-lint-checkers-data inferior-lint-checkers-data
(and inferior-lint-checkers-data (and inferior-lint-checkers-data
(with-time-logging "fetching inferior lint warnings" (par-map&
(par-map& (match-lambda
(match-lambda ((checker-name _ network-dependent?)
((checker-name _ network-dependent?) (and (and (not network-dependent?)
(and (and (not network-dependent?) ;; Running the derivation linter is
;; Running the derivation linter is ;; currently infeasible
;; currently infeasible (not (eq? checker-name 'derivation)))
(not (eq? checker-name 'derivation))) (with-resource-from-pool inf-and-store-pool res
(with-resource-from-pool inf-and-store-pool res (match res
(match res ((inferior . inferior-store)
((inferior . inferior-store) (inferior-lint-warnings inferior
(inferior-lint-warnings inferior inferior-store
inferior-store checker-name)))))))
checker-name))))))) inferior-lint-checkers-data)))))
inferior-lint-checkers-data))))))
(inferior-packages-system-and-target-to-derivations-alist (inferior-packages-system-and-target-to-derivations-alist
(with-time-logging "getting inferior derivations" (par-map&
(par-map& (match-lambda
(match-lambda ((system . target)
((system . target) (with-resource-from-pool inf-and-store-pool res
(with-resource-from-pool inf-and-store-pool res (with-time-logging
(simple-format #f "getting derivations for ~A" (cons system target))
(match res (match res
((inferior . inferior-store) ((inferior . inferior-store)
(ensure-gds-inferior-packages-defined! inferior) (ensure-gds-inferior-packages-defined! inferior)
(cons (cons system target) (let ((drvs
(inferior-package-derivations inferior-store (inferior-package-derivations
inferior inferior-store
system inferior
target))))))) system
(with-resource-from-pool inf-and-store-pool res target)))
(match res
((inferior . inferior-store) (vector-for-each
(inferior-fetch-system-target-pairs inferior))))))) (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 (inferior-system-tests
(if skip-system-tests? (if skip-system-tests?
(begin (begin
@ -1502,17 +1509,16 @@
guix-source commit guix-source commit
add-temp-root/long-running-store))))))) add-temp-root/long-running-store)))))))
(packages-data (packages-data
(with-time-logging "getting all inferior package data" (with-resource-from-pool inf-and-store-pool res
(with-resource-from-pool inf-and-store-pool res (match res
(match res ((inferior . inferior-store)
((inferior . inferior-store) (with-time-logging "getting all inferior package data"
(with-time-logging "fetching inferior packages" (let ((packages
(let ((packages pkg-to-replacement-hash-table
pkg-to-replacement-hash-table (inferior-packages-plus-replacements inferior)))
(inferior-packages-plus-replacements inferior))) (all-inferior-packages-data inferior
(all-inferior-packages-data inferior packages
packages pkg-to-replacement-hash-table))))))))
pkg-to-replacement-hash-table)))))))))
(destroy-resource-pool inf-and-store-pool) (destroy-resource-pool inf-and-store-pool)