[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/04: package: Add --manifest option.
|
From: |
David Thompson |
|
Subject: |
04/04: package: Add --manifest option. |
|
Date: |
Wed, 20 May 2015 16:30:22 +0000 |
davexunit pushed a commit to branch master
in repository guix.
commit 1b6764477fda1a71f0ed377546f49adf2e36e5cb
Author: David Thompson <address@hidden>
Date: Thu May 14 21:11:57 2015 -0400
package: Add --manifest option.
* guix/scripts/package.scm (show-help): Add help text.
(%options): Add manifest option.
(guix-package): Add manifest option handler.
* doc/guix.texi ("Invoking guix package"): Document it.
* tests/guix-package.sh: Add test.
---
doc/guix.texi | 17 +++++++
guix/scripts/package.scm | 107 +++++++++++++++++++++++++++-------------------
tests/guix-package.sh | 12 +++++
3 files changed, 92 insertions(+), 44 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 53c9fb2..9b2e367 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1068,6 +1068,23 @@ substring ``emacs'':
$ guix package --upgrade . --do-not-upgrade emacs
@end example
address@hidden address@hidden
address@hidden -m @var{file}
+Create a new @dfn{generation} of the profile from the manifest object
+returned by the Scheme code in @var{file}.
+
+A manifest file may look like this:
+
address@hidden
+(use-package-modules guile emacs gcc)
+
+(packages->manifest
+ (list guile-2.0
+ emacs
+ ;; Use a specific package output.
+ (list gcc "debug")))
address@hidden example
+
@item --roll-back
Roll back to the previous @dfn{generation} of the profile---i.e., undo
the last transaction.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d6d7c66..1251734 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -433,6 +433,9 @@ Install, remove, or upgrade PACKAGES in a single
transaction.\n"))
(display (_ "
-u, --upgrade[=REGEXP] upgrade all the installed packages matching REGEXP"))
(display (_ "
+ -m, --manifest=FILE create a new profile generation with the manifest
+ from FILE"))
+ (display (_ "
--do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP"))
(display (_ "
--roll-back roll back to the previous generation"))
@@ -524,6 +527,10 @@ Install, remove, or upgrade PACKAGES in a single
transaction.\n"))
(lambda (opt name arg result arg-handler)
(values (alist-cons 'roll-back? #t result)
#f)))
+ (option '(#\m "manifest") #t #f
+ (lambda (opt name arg result arg-handler)
+ (values (alist-cons 'manifest arg result)
+ arg-handler)))
(option '(#\l "list-generations") #f #t
(lambda (opt name arg result arg-handler)
(values (cons `(query list-generations ,(or arg ""))
@@ -800,6 +807,50 @@ more information.~%"))
(define dry-run? (assoc-ref opts 'dry-run?))
(define profile (assoc-ref opts 'profile))
+ (define (build-and-use-profile manifest)
+ (let* ((bootstrap? (assoc-ref opts 'bootstrap?)))
+
+ (when (equal? profile %current-profile)
+ (ensure-default-profile))
+
+ (let* ((prof-drv (run-with-store (%store)
+ (profile-derivation
+ manifest
+ #:hooks (if bootstrap?
+ '()
+ %default-profile-hooks))))
+ (prof (derivation->output-path prof-drv)))
+ (show-what-to-build (%store) (list prof-drv)
+ #:use-substitutes?
+ (assoc-ref opts 'substitutes?)
+ #:dry-run? dry-run?)
+
+ (cond
+ (dry-run? #t)
+ ((and (file-exists? profile)
+ (and=> (readlink* profile) (cut string=? prof <>)))
+ (format (current-error-port) (_ "nothing to be done~%")))
+ (else
+ (let* ((number (generation-number profile))
+
+ ;; Always use NUMBER + 1 for the new profile,
+ ;; possibly 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)))
+ (switch-symlinks name prof)
+ (switch-symlinks profile 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 profile)))))))))
+
;; First roll back if asked to.
(cond ((and (assoc-ref opts 'roll-back?)
(not dry-run?))
@@ -834,60 +885,28 @@ more information.~%"))
(alist-delete 'delete-generations opts)))
(_ #f))
opts))
+ ((and (assoc-ref opts 'manifest)
+ (not dry-run?))
+ (let* ((file-name (assoc-ref opts 'manifest))
+ (user-module (make-user-module '((guix profiles)
+ (gnu))))
+ (manifest (load* file-name user-module)))
+ (format #t (_ "installing new manifest from ~a with ~d
entries.~%")
+ file-name (length (manifest-entries manifest)))
+ (build-and-use-profile manifest)))
(else
(let* ((manifest (profile-manifest profile))
(install (options->installable opts manifest))
(remove (options->removable opts manifest))
- (bootstrap? (assoc-ref opts 'bootstrap?))
(transaction (manifest-transaction (install install)
(remove remove)))
(new (manifest-perform-transaction
manifest transaction)))
- (when (equal? profile %current-profile)
- (ensure-default-profile))
-
(unless (and (null? install) (null? remove))
- (let* ((prof-drv (run-with-store (%store)
- (profile-derivation
- new
- #:hooks (if bootstrap?
- '()
- %default-profile-hooks))))
- (prof (derivation->output-path prof-drv)))
- (show-manifest-transaction (%store) manifest transaction
- #:dry-run? dry-run?)
- (show-what-to-build (%store) (list prof-drv)
- #:use-substitutes?
- (assoc-ref opts 'substitutes?)
- #:dry-run? dry-run?)
-
- (cond
- (dry-run? #t)
- ((and (file-exists? profile)
- (and=> (readlink* profile) (cut string=? prof <>)))
- (format (current-error-port) (_ "nothing to be done~%")))
- (else
- (let* ((number (generation-number profile))
-
- ;; Always use NUMBER + 1 for the new profile,
- ;; possibly overwriting a "previous future
- ;; generation".
- (name (generation-file-name profile
- (+ 1 number))))
- (and (build-derivations (%store) (list prof-drv))
- (let* ((entries (manifest-entries new))
- (count (length entries)))
- (switch-symlinks name prof)
- (switch-symlinks profile 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
- profile))))))))))))
+ (show-manifest-transaction (%store) manifest transaction
+ #:dry-run? dry-run?)
+ (build-and-use-profile new))))))
(define (process-query opts)
;; Process any query specified by OPTS. Return #t when a query was
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index d420b80..26a5e9d 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -242,3 +242,15 @@ export GUIX_BUILD_OPTIONS
available2="`guix package -A | sort`"
test "$available2" = "$available"
guix package -I
+
+unset GUIX_BUILD_OPTIONS
+
+# Applying a manifest file
+cat > "$module_dir/manifest.scm"<<EOF
+(use-package-modules bootstrap)
+
+(packages->manifest (list %bootstrap-guile))
+EOF
+guix package --bootstrap -m "$module_dir/manifest.scm"
+guix package -I | grep guile
+test `guix package -I | wc -l` -eq 1