diff mbox series

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

Message ID 367d0f5cffef102e3e4cdbaabcc093e94a74b180.1737201981.git.iyzsong@member.fsf.org
State New
Headers
Series [bug#75647,v2,1/2] profiles: Add #:build? argument to lower-manifest-entry. |

Commit Message

iyzsong--- via Guix-patches via Jan. 18, 2025, 12:07 p.m. UTC 
  From: 宋文武 <iyzsong@member.fsf.org>

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

Change-Id: Ifb86d581156034897377f3614fac67b7748e0ec3
---
 guix/profiles.scm | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)


base-commit: 87045f0982bd7aebb07b380cbf322651227546f4
diff mbox series

Patch

diff --git a/guix/profiles.scm b/guix/profiles.scm
index a28cf872cf..0f47268541 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -3,7 +3,7 @@ 
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 ;;; Copyright © 2014, 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
-;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
+;;; Copyright © 2015, 2025 宋文武 <iyzsong@envs.net>
 ;;; Copyright © 2016, 2017, 2018, 2019, 2021, 2022 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
@@ -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,20 @@  (define* (lower-manifest-entry entry system #:key target)
 
   (let ((item (manifest-entry-item entry)))
     (if (string? item)
-        (with-monad %store-monad
+        (mbegin %store-monad
+          (build (list item))
+          (if build?
+              (build (list item))
+              (return #t))
           (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 #t))))
           (return (manifest-entry
                     (inherit entry)
                     (item (derivation->output-path drv output))