guix package: Add '--switch-generation' option.

* guix/scripts/package.scm (switch-to-generation): New procedure.
  (switch-to-previous-generation): Use it.
  (guix-package): Adjust for '--switch-generation' option.
* tests/guix-package.sh: Test it.
* doc/guix.texi (Invoking guix package): Document it.

3 files changed, 76 insertions, 12 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index 13bcd103ca..bbe84ab275 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -806,6 +806,21 @@ Installing, removing, or upgrading packages from a generation that has
 been rolled back to overwrites previous future generations.  Thus, the
 history of a profile's generations is always linear.
 
+@item --switch-generation=@var{pattern}
+@itemx -S @var{pattern}
+Switch to a particular generation defined by @var{pattern}.
+
+@var{pattern} may be either a generation number or a number prefixed
+with ``+'' or ``-''.  The latter means: move forward/backward by a
+specified number of generations.  For example, if you want to return to
+the latest generation after @code{--roll-back}, use
+@code{--switch-generation=+1}.
+
+The difference between @code{--roll-back} and
+@code{--switch-generation=-1} is that @code{--switch-generation} will
+not make a zeroth generation, so if a specified generation does not
+exist, the current generation will not be changed.
+
 @item --search-paths
 @cindex search paths
 Report environment variable definitions, in Bash syntax, that may be
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index ab9d303127..3a72053766 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -46,6 +46,8 @@
   #:use-module (gnu packages guile)
   #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile))
   #:export (specification->package+output
+            switch-to-generation
+            switch-to-previous-generation
             roll-back
             delete-generation
             delete-generations
@@ -96,14 +98,26 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
 
     (switch-symlinks generation prof)))
 
+(define (switch-to-generation profile number)
+  "Atomically switch PROFILE to the generation NUMBER."
+  (let ((current    (generation-number profile))
+        (generation (generation-file-name profile number)))
+    (cond ((not (file-exists? profile))
+           (raise (condition (&profile-not-found-error
+                              (profile profile)))))
+          ((not (file-exists? generation))
+           (raise (condition (&missing-generation-error
+                              (profile profile)
+                              (generation number)))))
+          (else
+           (format #t (_ "switching from generation ~a to ~a~%")
+                   current number)
+           (switch-symlinks profile generation)))))
+
 (define (switch-to-previous-generation profile)
   "Atomically switch PROFILE to the previous generation."
-  (let* ((number              (generation-number profile))
-         (previous-number     (previous-generation-number profile number))
-         (previous-generation (generation-file-name profile previous-number)))
-    (format #t (_ "switching from generation ~a to ~a~%")
-            number previous-number)
-    (switch-symlinks profile previous-generation)))
+  (switch-to-generation profile
+                        (previous-generation-number profile)))
 
 (define (roll-back store profile)
   "Roll back to the previous generation of PROFILE."
@@ -411,6 +425,9 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
   -d, --delete-generations[=PATTERN]
                          delete generations matching PATTERN"))
   (display (_ "
+  -S, --switch-generation=PATTERN
+                         switch to a generation matching PATTERN"))
+  (display (_ "
   -p, --profile=PROFILE  use PROFILE instead of the user's default profile"))
   (newline)
   (display (_ "
@@ -490,6 +507,10 @@ Install, remove, or upgrade PACKAGES in a single transaction.\n"))
                    (values (alist-cons 'delete-generations (or arg "")
                                        result)
                            #f)))
+         (option '(#\S "switch-generation") #t #f
+                 (lambda (opt name arg result arg-handler)
+                   (values (alist-cons 'switch-generation arg result)
+                           #f)))
          (option '("search-paths") #f #f
                  (lambda (opt name arg result arg-handler)
                    (values (cons `(query search-paths) result)
@@ -715,13 +736,31 @@ more information.~%"))
       (generation-number profile))
 
     ;; First roll back if asked to.
-    (cond ((and (assoc-ref opts 'roll-back?) (not dry-run?))
-           (begin
-             (roll-back (%store) profile)
-             (process-actions (alist-delete 'roll-back? opts))))
+    (cond ((and (assoc-ref opts 'roll-back?)
+                (not dry-run?))
+           (roll-back (%store) profile)
+           (process-actions (alist-delete 'roll-back? opts)))
+          ((and (assoc-ref opts 'switch-generation)
+                (not dry-run?))
+           (for-each
+            (match-lambda
+              (('switch-generation . pattern)
+               (let* ((number (string->number pattern))
+                      (number (and number
+                                   (case (string-ref pattern 0)
+                                     ((#\+ #\-)
+                                      (relative-generation profile number))
+                                     (else number)))))
+                 (if number
+                     (switch-to-generation profile number)
+                     (leave (_ "cannot switch to generation '~a'~%")
+                            pattern)))
+               (process-actions (alist-delete 'switch-generation opts)))
+              (_ #f))
+            opts))
           ((and (assoc-ref opts 'delete-generations)
                 (not dry-run?))
-           (filter-map
+           (for-each
             (match-lambda
              (('delete-generations . pattern)
               (cond ((not (file-exists? profile)) ; XXX: race condition
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index e35871f2a2..3e0e36fa23 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -87,6 +87,8 @@ then
     # Exit with 1 when a generation does not exist.
     if guix package -p "$profile" --list-generations=42;
     then false; else true; fi
+    if guix package -p "$profile" --switch-generation=99;
+    then false; else true; fi
 
     # Remove a package.
     guix package --bootstrap -p "$profile" -r "guile-bootstrap"
@@ -101,6 +103,12 @@ then
     test "`readlink_base "$profile"`" = "$profile-1-link"
     test -x "$profile/bin/guile" && ! test -x "$profile/bin/make"
 
+    # Switch to the rolled generation and switch back.
+    guix package -p "$profile" --switch-generation=2
+    test "`readlink_base "$profile"`" = "$profile-2-link"
+    guix package -p "$profile" --switch-generation=-1
+    test "`readlink_base "$profile"`" = "$profile-1-link"
+
     # Move to the empty profile.
     for i in `seq 1 3`
     do
@@ -133,10 +141,12 @@ then
     grep "`guix build -e "$boot_make"`" "$profile/manifest"
 
     # Make a "hole" in the list of generations, and make sure we can
-    # roll back "over" it.
+    # roll back and switch "over" it.
     rm "$profile-1-link"
     guix package --bootstrap -p "$profile" --roll-back
     test "`readlink_base "$profile"`" = "$profile-0-link"
+    guix package -p "$profile" --switch-generation=+1
+    test "`readlink_base "$profile"`" = "$profile-2-link"
 
     # Make sure LIBRARY_PATH gets listed by `--search-paths'.
     guix package --bootstrap -p "$profile" -i guile-bootstrap -i gcc-bootstrap