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
(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)))
proc))
(define (sort-and-deduplicate-inferior-packages packages
pkg-to-replacement-hash-table)
@ -1455,7 +1453,6 @@
(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?)
@ -1469,26 +1466,36 @@
(inferior-lint-warnings inferior
inferior-store
checker-name)))))))
inferior-lint-checkers-data))))))
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
(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
(let ((drvs
(inferior-package-derivations
inferior-store
inferior
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
(match res
((inferior . inferior-store)
(inferior-fetch-system-target-pairs inferior)))))))
(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"
(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)))))))))
pkg-to-replacement-hash-table))))))))
(destroy-resource-pool inf-and-store-pool)