Re: [PATCH] guix package: allow multiple arguments after -i, -r, and -u

[Mark H Weaver]

address@hidden (Ludovic Courtès) writes:
> Looks great to me!

Excellent!  Here's an updated patch incorporating your suggestions,
and also with the following additional changes:

* Arguments to install and remove are now optional, so --install a b
  works without the '='.

* I fixed a bug where "--upgrade gcc" (without the '=') would upgrade
  everything.

* I updated the manual to reflect the new syntax, by adding @dots{}
  in a few places with small changes to the text.

What do you think?

      Mark


>From 178bbd252b1b6b5b9b0d775af3d98992188f9849 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <address@hidden>
Date: Fri, 13 Dec 2013 15:37:57 -0500
Subject: [PATCH] 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.
---
 doc/guix.texi            |   32 +++++++----
 guix/scripts/package.scm |  136 ++++++++++++++++++++++++++++------------------
 tests/guix-package.sh    |    3 +
 3 files changed, 107 insertions(+), 64 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8483dbb..36297db 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
address@hidden in a single transaction:
+
address@hidden
+guix package -r lua -i guile guile-cairo
address@hidden 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
 
address@hidden address@hidden
address@hidden -i @var{package}
-Install @var{package}.
address@hidden address@hidden @dots{}
address@hidden -i @var{package} @dots{}
+Install the specified @var{package}s.
 
address@hidden 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.
 
address@hidden address@hidden
address@hidden -r @var{package}
-Remove @var{package}.
address@hidden address@hidden @dots{}
address@hidden -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}.
 
address@hidden address@hidden
address@hidden -u address@hidden
-Upgrade all the installed packages.  When @var{regexp} is specified, upgrade
-only installed packages whose name matches @var{regexp}.
address@hidden address@hidden @dots{}]
address@hidden -u address@hidden @dots{}]
+Upgrade all the installed packages.  If one or more @var{regexp}s are
+specified, upgrade only installed packages whose name matches a
address@hidden
 
 Note that this upgrades package to the latest version of packages found
 in the distribution currently installed.  To update your distribution,
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 2890d54..49fa457 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -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.
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 9116f35..47a2d06 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -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
 
-- 
1.7.5.4