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

32
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
(simple-format #f "getting derivations for ~A" (cons system target))
(inferior-eval-with-store/non-blocking (inferior-eval-with-store/non-blocking
inf inf
store store
proc))) 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,7 +1453,6 @@
(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?)
@ -1469,26 +1466,36 @@
(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-store
inferior inferior
system system
target))))))) 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 (with-resource-from-pool inf-and-store-pool res
(match res (match res
((inferior . inferior-store) ((inferior . inferior-store)
(inferior-fetch-system-target-pairs inferior))))))) (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 "fetching inferior packages" (with-time-logging "getting all inferior package data"
(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)