guix-patches
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[bug#34060] [PATCH 06/10] pull: Build profile with 'channel-instances->d


From: Ludovic Courtès
Subject: [bug#34060] [PATCH 06/10] pull: Build profile with 'channel-instances->derivation'.
Date: Sun, 13 Jan 2019 16:47:29 +0100

* guix/scripts/package.scm (build-and-use-profile): Rename 'manifest' to
'manifest-or-derivation' and allow it to be a derivation.
* guix/scripts/pull.scm (build-and-install): Use
'channel-instances->derivation' instead of 'channel-instances->manifest'.
---
 guix/scripts/package.scm | 41 ++++++++++++++++++++++------------------
 guix/scripts/pull.scm    |  4 ++--
 2 files changed, 25 insertions(+), 20 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 872a7303fc..4f483ac141 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -118,24 +118,27 @@ denote ranges as interpreted by 'matching-generations'."
           (else
            (leave (G_ "invalid syntax: ~a~%") pattern)))))
 
-(define* (build-and-use-profile store profile manifest
+(define* (build-and-use-profile store profile manifest-or-derivation
                                 #:key
                                 allow-collisions?
                                 bootstrap? use-substitutes?
                                 dry-run?)
   "Build a new generation of PROFILE, a file name, using the packages
-specified in MANIFEST, a manifest object.  When ALLOW-COLLISIONS? is true,
-do not treat collisions in MANIFEST as an error."
+specified in MANIFEST-OR-DERIVATION, a manifest object or a profile
+derivation.  When ALLOW-COLLISIONS? is true, do not treat collisions in
+MANIFEST-OR-DERIVATION as an error."
   (when (equal? profile %current-profile)
     (ensure-default-profile))
 
-  (let* ((prof-drv (run-with-store store
-                     (profile-derivation manifest
-                                         #:allow-collisions? allow-collisions?
-                                         #:hooks (if bootstrap?
-                                                     '()
-                                                     %default-profile-hooks)
-                                         #:locales? (not bootstrap?))))
+  (let* ((prof-drv (if (derivation? manifest-or-derivation)
+                       manifest-or-derivation
+                       (run-with-store store
+                         (profile-derivation manifest-or-derivation
+                                             #:allow-collisions? 
allow-collisions?
+                                             #:hooks (if bootstrap?
+                                                         '()
+                                                         
%default-profile-hooks)
+                                             #:locales? (not bootstrap?)))))
          (prof     (derivation->output-path prof-drv)))
     (show-what-to-build store (list prof-drv)
                         #:use-substitutes? use-substitutes?
@@ -153,18 +156,20 @@ do not treat collisions in MANIFEST as an error."
              ;; overwriting a "previous future generation".
              (name   (generation-file-name profile (+ 1 number))))
         (and (build-derivations store (list prof-drv))
-             (let* ((entries (manifest-entries manifest))
-                    (count   (length entries)))
+             (let* ((entries (and (manifest? manifest-or-derivation)
+                                  (manifest-entries manifest-or-derivation)))
+                    (count   (and entries (length entries))))
                (switch-symlinks name prof)
                (switch-symlinks profile (basename name))
                (unless (string=? profile %current-profile)
                  (register-gc-root store name))
-               (format #t (N_ "~a package in profile~%"
-                              "~a packages in profile~%"
-                              count)
-                       count)
-               (display-search-paths entries (list profile)
-                                     #:kind 'prefix)))
+               (when count
+                 (format #t (N_ "~a package in profile~%"
+                                "~a packages in profile~%"
+                                count)
+                         count)
+                 (display-search-paths entries (list profile)
+                                       #:kind 'prefix))))
 
         (warn-about-disk-space profile))))))
 
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 6d1914f7c2..ce3d24a7f7 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -186,9 +186,9 @@ true, display what would be built without actually building 
it."
   (define update-profile
     (store-lift build-and-use-profile))
 
-  (mlet %store-monad ((manifest (channel-instances->manifest instances)))
+  (mlet %store-monad ((drv (channel-instances->derivation instances)))
     (mbegin %store-monad
-      (update-profile profile manifest
+      (update-profile profile drv
                       #:dry-run? dry-run?)
       (munless dry-run?
         (return (display-profile-news profile))))))
-- 
2.20.1






reply via email to

[Prev in Thread] Current Thread [Next in Thread]