Below is a new patch set taking into account the feedback received thus
far. The (guix profiles) module still needs to be documented in the
manual, but there's quite a lot of procedures and variables to account
for. Would anyone be intertested in helping with this part?
>From d506ad1d8824cc694364be502acddb25b76d0020 Mon Sep 17 00:00:00 2001
From: David Thompson <dthomps...@worcester.edu>
Date: Mon, 18 May 2015 07:49:44 -0400
Subject: [PATCH 1/3] ui: Factorize user-provided Scheme file loading.
* guix/ui.scm (make-user-module, read-scheme-file): New procedures.
* guix/scripts/system.scm (%user-module): Define in terms of
'make-user-module'.
(read-operating-system): Define in terms of 'read-scheme-file'.
---
guix/scripts/system.scm | 22 ++++------------------
guix/ui.scm | 24 ++++++++++++++++++++++++
2 files changed, 28 insertions(+), 18 deletions(-)
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 1838e89..2d7c5d1 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -48,28 +48,14 @@
(define %user-module
;; Module in which the machine description file is loaded.
- (let ((module (make-fresh-user-module)))
- (for-each (lambda (iface)
- (module-use! module (resolve-interface iface)))
- '((gnu system)
- (gnu services)
- (gnu system shadow)))
- module))
+ (make-user-module '((gnu system)
+ (gnu services)
+ (gnu system shadow))))
(define (read-operating-system file)
"Read the operating-system declaration from FILE and return it."
- ;; TODO: Factorize.
- (catch #t
- (lambda ()
- ;; Avoid ABI incompatibility with the <operating-system> record.
- (set! %fresh-auto-compile #t)
+ (read-scheme-file file %user-module))
- (save-module-excursion
- (lambda ()
- (set-current-module %user-module)
- (primitive-load file))))
- (lambda args
- (report-load-error file args))))
;;;
diff --git a/guix/ui.scm b/guix/ui.scm
index 911e5ee..5a76cf4 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -48,6 +48,8 @@
P_
report-error
leave
+ make-user-module
+ read-scheme-file
report-load-error
warn-about-load-error
show-version-and-exit
@@ -133,6 +135,28 @@ messages."
(report-error args ...)
(exit 1)))
+(define (make-user-module modules)
+ "Return a new user module with the additional MODULES loaded."
+ ;; Module in which the machine description file is loaded.
+ (let ((module (make-fresh-user-module)))
+ (for-each (lambda (iface)
+ (module-use! module (resolve-interface iface)))
+ modules)
+ module))
+
+(define (read-scheme-file file user-module)
+ "Read the user provided Scheme source code FILE."
+ (catch #t
+ (lambda ()
+ (set! %fresh-auto-compile #t)
+
+ (save-module-excursion
+ (lambda ()
+ (set-current-module user-module)
+ (primitive-load file))))
+ (lambda args
+ (report-load-error file args))))
+
(define (report-load-error file args)
"Report the failure to load FILE, a user-provided Scheme file, and exit.
ARGS is the list of arguments received by the 'throw' handler."
--
2.1.4
>From 5665da9934726ce0a8c4ed358b7f606d917c300a Mon Sep 17 00:00:00 2001
From: David Thompson <dthomps...@worcester.edu>
Date: Mon, 18 May 2015 07:51:56 -0400
Subject: [PATCH 2/3] profiles: Add 'packages->manifest' procedure.
* guix/profiles.scm (packages->manifest): New procedure.
---
guix/profiles.scm | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 11d9bf0..cbc8a9a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -80,6 +80,7 @@
profile-manifest
package->manifest-entry
+ packages->manifest
%default-profile-hooks
profile-derivation
generation-number
@@ -172,6 +173,16 @@ omitted or #f, use the first output of PACKAGE."
(dependencies (delete-duplicates deps))
(search-paths (package-native-search-paths package)))))
+(define (packages->manifest packages)
+ "Convert PACKAGES into a manifest containing entries for all of them."
+ (manifest
+ (map (match-lambda
+ ((package output)
+ (package->manifest-entry package output))
+ (package
+ (package->manifest-entry package)))
+ packages)))
+
(define (manifest->gexp manifest)
"Return a representation of MANIFEST as a gexp."
(define (entry->gexp entry)
--
2.1.4
>From 3be657353bfebc33dc9733b820165699ac07b43d Mon Sep 17 00:00:00 2001
From: David Thompson <dthomps...@worcester.edu>
Date: Thu, 14 May 2015 21:11:57 -0400
Subject: [PATCH 3/3] 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 | 10 +++++
3 files changed, 90 insertions(+), 44 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 049292d..ca5f82d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1057,6 +1057,23 @@ substring ``emacs'':
$ guix package --upgrade . --do-not-upgrade emacs
@end example
+@item --manifest=@var{file}
+@itemx -m @var{file}
+Create a new @dfn{generation} of the profile from the manifest object
+contained in @var{file}, a Scheme source code file.
+
+A manifest file may look like this:
+
+@example
+(use-package-modules guile emacs gcc)
+
+(packages->manifest
+ (list guile-2.0
+ emacs
+ ;; Use a specific package output.
+ (list gcc "debug")))
+@end 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 15f3e13..f2ca663 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -426,6 +426,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
+ contained within FILE."))
+ (display (_ "
--do-not-upgrade[=REGEXP] do not upgrade any packages matching REGEXP"))
(display (_ "
--roll-back roll back to the previous generation"))
@@ -517,6 +520,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 ""))
@@ -783,6 +790,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?))
@@ -817,60 +868,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 (read-scheme-file 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 a732110..4591333 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -237,3 +237,13 @@ 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"
--
2.1.4
--
David Thompson
GPG Key: 0FF1D807
