From ac1a4cb1e28896631b8774a7b607f4f0bd6dc3c2 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Fri, 2 Feb 2024 16:58:06 +0100
Subject: Cleanup some with-time-logging

---
 guix-data-service/jobs/load-new-guix-revision.scm | 98 ++++++++++++-----------
 1 file changed, 52 insertions(+), 46 deletions(-)

(limited to 'guix-data-service')

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)
 
-- 
cgit v1.2.3