[bug#75647,1/2] profiles: Add #:build? argument to lower-manifest-entry.

Message ID 11916b9f37612909f6ba4e07ca06ab903b7679ac.1737200329.git.iyzsong@member.fsf.org
State New
Headers
Series Optimize profile hooks to avoid unnecessary reruns. |

Commit Message

Alexis Praga via Guix-patches via Jan. 18, 2025, 11:41 a.m. UTC
  From: 宋文武 <iyzsong@member.fsf.org>

* guix/profiles.scm (lower-manifest-entry): Add #:build? keyword argument.

Change-Id: Iab2832d1bac1b28f6124e0c4e78e9284daf9a2ea
---
 guix/profiles.scm | 18 +++++++++++++-----
 1 file changed, 13 insertions(+), 5 deletions(-)
  

Patch

diff --git a/guix/profiles.scm b/guix/profiles.scm
index a28cf872cf..a05b90d685 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -308,9 +308,10 @@  (define (manifest-entry-lookup manifest)
       ((_ . entry) entry)
       (#f          #f))))
 
-(define* (lower-manifest-entry entry system #:key target)
+(define* (lower-manifest-entry entry system #:key target
+                               (build? #f))
   "Lower ENTRY for SYSTEM and TARGET such that its 'item' field is a store
-file name."
+file name.  When BUILD? is true, build the entry before returning."
   (define (recurse entry)
     (mapm/accumulate-builds (lambda (entry)
                               (lower-manifest-entry entry system
@@ -319,12 +320,19 @@  (define* (lower-manifest-entry entry system #:key target)
 
   (let ((item (manifest-entry-item entry)))
     (if (string? item)
-        (with-monad %store-monad
+        (mbegin %store-monad
+          (if (build?)
+              (build (list item))
+              (return #f))
           (return entry))
-        (mlet %store-monad ((drv (lower-object item system
+        (mlet* %store-monad ((drv (lower-object item system
                                                #:target target))
+
                             (dependencies (recurse entry))
-                            (output -> (manifest-entry-output entry)))
+                            (output -> (manifest-entry-output entry))
+                            (built (if build?
+                                       (built-derivations (list (cons drv output)))
+                                       (return #f))))
           (return (manifest-entry
                     (inherit entry)
                     (item (derivation->output-path drv output))