~ruther/guix-local

6447738c013cf205959ca4afd1a97248fb9ccf58 — Mark H Weaver 12 years ago 5839958
guix package: allow multiple arguments after -i, -r, and -u.

* guix/scripts/package.scm (%options): Adapt option processors to accept and
  return a second seed value: 'arg-handler', which handles bare arguments (if
  not false).  The install, remove, and upgrade option processors return an
  arg-handler that repeat the same operation.  All other option processors
  return #f as the arg-handler.  Make the arguments to install and remove
  optional.  The upgrade option processor deletes (upgrade . #f) from the
  alist before adding a new entry.
  (guix-package): Procedures passed to 'args-fold*' accept the new seed value
  'arg-handler'.  The 'operand-proc' uses 'arg-handler' (if not false).

* doc/guix.texi (Invoking guix package): Update docs.

* tests/guix-package.sh: Add test.
3 files changed, 107 insertions(+), 64 deletions(-)

M doc/guix.texi
M guix/scripts/package.scm
M tests/guix-package.sh
M doc/guix.texi => doc/guix.texi +20 -12
@@ 501,6 501,13 @@ the transaction.  Upon completion, a new profile is created, but
previous generations of the profile remain available, should the user
want to roll back.

For example, to remove @code{lua} and install @code{guile} and
@code{guile-cairo} in a single transaction:

@example
guix package -r lua -i guile guile-cairo
@end example

For each user, a symlink to the user's default profile is automatically
created in @file{$HOME/.guix-profile}.  This symlink always points to the
current generation of the user's default profile.  Thus, users can add


@@ 522,11 529,11 @@ The @var{options} can be among the following:

@table @code

@item --install=@var{package}
@itemx -i @var{package}
Install @var{package}.
@item --install=@var{package} @dots{}
@itemx -i @var{package} @dots{}
Install the specified @var{package}s.

@var{package} may specify either a simple package name, such as
Each @var{package} may specify either a simple package name, such as
@code{guile}, or a package name followed by a hyphen and version number,
such as @code{guile-1.8.8}.  If no version number is specified, the
newest available version will be selected.  In addition, @var{package}


@@ 568,19 575,20 @@ Note that this option installs the first output of the specified
package, which may be insufficient when needing a specific output of a
multiple-output package.

@item --remove=@var{package}
@itemx -r @var{package}
Remove @var{package}.
@item --remove=@var{package} @dots{}
@itemx -r @var{package} @dots{}
Remove the specified @var{package}s.

As for @code{--install}, @var{package} may specify a version number
As for @code{--install}, each @var{package} may specify a version number
and/or output name in addition to the package name.  For instance,
@code{-r glibc:debug} would remove the @code{debug} output of
@code{glibc}.

@item --upgrade[=@var{regexp}]
@itemx -u [@var{regexp}]
Upgrade all the installed packages.  When @var{regexp} is specified, upgrade
only installed packages whose name matches @var{regexp}.
@item --upgrade[=@var{regexp} @dots{}]
@itemx -u [@var{regexp} @dots{}]
Upgrade all the installed packages.  If one or more @var{regexp}s are
specified, upgrade only installed packages whose name matches a
@var{regexp}.

Note that this upgrades package to the latest version of packages found
in the distribution currently installed.  To update your distribution,

M guix/scripts/package.scm => guix/scripts/package.scm +84 -52
@@ 523,70 523,99 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                (lambda args
                  (show-version-and-exit "guix package")))

        (option '(#\i "install") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'install arg result)))
        (option '(#\i "install") #f #t
                (lambda (opt name arg result arg-handler)
                  (let arg-handler ((arg arg) (result result))
                    (values (if arg
                                (alist-cons 'install arg result)
                                result)
                            arg-handler))))
        (option '(#\e "install-from-expression") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'install (read/eval-package-expression arg)
                              result)))
        (option '(#\r "remove") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'remove arg result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'install (read/eval-package-expression arg)
                                      result)
                          #f)))
        (option '(#\r "remove") #f #t
                (lambda (opt name arg result arg-handler)
                  (let arg-handler ((arg arg) (result result))
                    (values (if arg
                                (alist-cons 'remove arg result)
                                result)
                            arg-handler))))
        (option '(#\u "upgrade") #f #t
                (lambda (opt name arg result)
                  (alist-cons 'upgrade arg result)))
                (lambda (opt name arg result arg-handler)
                  (let arg-handler ((arg arg) (result result))
                    (values (alist-cons 'upgrade arg
                                        ;; Delete any prior "upgrade all"
                                        ;; command, or else "--upgrade gcc"
                                        ;; would upgrade everything.
                                        (delete '(upgrade . #f) result))
                            arg-handler))))
        (option '("roll-back") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'roll-back? #t result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'roll-back? #t result)
                          #f)))
        (option '(#\l "list-generations") #f #t
                (lambda (opt name arg result)
                  (cons `(query list-generations ,(or arg ""))
                        result)))
                (lambda (opt name arg result arg-handler)
                  (values (cons `(query list-generations ,(or arg ""))
                                result)
                          #f)))
        (option '(#\d "delete-generations") #f #t
                (lambda (opt name arg result)
                  (alist-cons 'delete-generations (or arg "")
                              result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'delete-generations (or arg "")
                                      result)
                          #f)))
        (option '("search-paths") #f #f
                (lambda (opt name arg result)
                  (cons `(query search-paths) result)))
                (lambda (opt name arg result arg-handler)
                  (values (cons `(query search-paths) result)
                          #f)))
        (option '(#\p "profile") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'profile arg
                              (alist-delete 'profile result))))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'profile arg
                                      (alist-delete 'profile result))
                          #f)))
        (option '(#\n "dry-run") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'dry-run? #t result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'dry-run? #t result)
                          #f)))
        (option '("fallback") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'fallback? #t
                              (alist-delete 'fallback? result))))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'fallback? #t
                                      (alist-delete 'fallback? result))
                          #f)))
        (option '("no-substitutes") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'substitutes? #f
                              (alist-delete 'substitutes? result))))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'substitutes? #f
                                      (alist-delete 'substitutes? result))
                          #f)))
        (option '("max-silent-time") #t #f
                (lambda (opt name arg result)
                  (alist-cons 'max-silent-time (string->number* arg)
                              result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'max-silent-time (string->number* arg)
                                      result)
                          #f)))
        (option '("bootstrap") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'bootstrap? #t result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'bootstrap? #t result)
                          #f)))
        (option '("verbose") #f #f
                (lambda (opt name arg result)
                  (alist-cons 'verbose? #t result)))
                (lambda (opt name arg result arg-handler)
                  (values (alist-cons 'verbose? #t result)
                          #f)))
        (option '(#\s "search") #t #f
                (lambda (opt name arg result)
                  (cons `(query search ,(or arg ""))
                        result)))
                (lambda (opt name arg result arg-handler)
                  (values (cons `(query search ,(or arg ""))
                                result)
                          #f)))
        (option '(#\I "list-installed") #f #t
                (lambda (opt name arg result)
                  (cons `(query list-installed ,(or arg ""))
                        result)))
                (lambda (opt name arg result arg-handler)
                  (values (cons `(query list-installed ,(or arg ""))
                                result)
                          #f)))
        (option '(#\A "list-available") #f #t
                (lambda (opt name arg result)
                  (cons `(query list-available ,(or arg ""))
                        result)))))
                (lambda (opt name arg result arg-handler)
                  (values (cons `(query list-available ,(or arg ""))
                                result)
                          #f)))))

(define (options->installable opts manifest)
  "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',


@@ 717,11 746,14 @@ removed from MANIFEST."
  (define (parse-options)
    ;; Return the alist of option values.
    (args-fold* args %options
                (lambda (opt name arg result)
                (lambda (opt name arg result arg-handler)
                  (leave (_ "~A: unrecognized option~%") name))
                (lambda (arg result)
                  (leave (_ "~A: extraneous argument~%") arg))
                %default-options))
                (lambda (arg result arg-handler)
                  (if arg-handler
                      (arg-handler arg result)
                      (leave (_ "~A: extraneous argument~%") arg)))
                %default-options
                #f))

  (define (guile-missing?)
    ;; Return #t if %GUILE-FOR-BUILD is not available yet.

M tests/guix-package.sh => tests/guix-package.sh +3 -0
@@ 155,6 155,9 @@ then
    guix package -p "$profile" --delete-generations=0
fi

# Make sure multiple arguments to -i works.
guix package --bootstrap -i guile gcc -p "$profile" -n

# Make sure the `:' syntax works.
guix package --bootstrap -i "binutils:lib" -p "$profile" -n