summary refs log tree commit diff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2015-05-14 21:11:57 -0400
committerDavid Thompson <dthompson2@worcester.edu>2015-05-20 12:13:04 -0400
commit1b6764477fda1a71f0ed377546f49adf2e36e5cb (patch)
tree6b5287296f1f0b34e50680907495916c65aee446
parent8404ed5c3e3a36958dc0427531b21ae14b6398aa (diff)
downloadguix-1b6764477fda1a71f0ed377546f49adf2e36e5cb.tar.gz
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.
-rw-r--r--doc/guix.texi17
-rw-r--r--guix/scripts/package.scm107
-rw-r--r--tests/guix-package.sh12
3 files changed, 92 insertions, 44 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 53c9fb2d44..9b2e367d0c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1068,6 +1068,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
+returned by the Scheme code in @var{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 d6d7c66cf3..1251734062 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 d420b8076d..26a5e9d1a2 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