~ruther/guix-local

1b6764477fda1a71f0ed377546f49adf2e36e5cb — David Thompson 11 years ago 8404ed5
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.
3 files changed, 92 insertions(+), 44 deletions(-)

M doc/guix.texi
M guix/scripts/package.scm
M tests/guix-package.sh
M doc/guix.texi => doc/guix.texi +17 -0
@@ 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.

M guix/scripts/package.scm => guix/scripts/package.scm +63 -44
@@ 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

M tests/guix-package.sh => tests/guix-package.sh +12 -0
@@ 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