Re: [PATCH] guix package: Add '--switch-generation' option.

[Alex Kost <alezost@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2916 bytes --]

Ludovic Courtès (2014-10-07 20:00 +0400) wrote:

> Alex Kost <alezost@gmail.com> skribis:
>
> [...]
>
>> +(define (switch-to-generation profile number)
>> +  "Atomically switch PROFILE to the generation NUMBER."
>> +  (let ((current (generation-number profile))
>> +        (file    (generation-file-name profile number)))
>> +    (cond ((not (file-exists? profile))
>> +           (format (current-error-port)
>> +                   (_ "profile '~a' does not exist~%")
>> +                   profile))
>> +          ((not (file-exists? file))
>> +           (format (current-error-port)
>> +                   (_ "generation ~a does not exist~%")
>> +                   number))
>> +          (else
>> +           (format #t (_ "switching from generation ~a to ~a~%")
>> +                   current number)
>> +           (switch-symlinks profile file)))))
>
> Could this procedure raise an exception instead of writing messages?
> The reason is that I’d like UI code to remain in (guix scripts package),
> in the Emacs code, and in guix-web, with (guix profiles) remaining
> generic.

I see, thanks for the explanation.

> It’d be enough for me to just call ‘switch-symlinks’ and let it throw
> ‘system-error’ if something’s wrong.  The exception will be caught, the
> user will see a “No such file” error, and ‘guix package’ with exit with
> non-zero (this is done by ‘call-with-error-handling’.)

‘switch-symlinks’ does not throw an error even if files don't exist, so…

> It’s less informative than what you did, though.  The other option would
> be to define specific error condition types and throw them from here.
>
> WDYT?

… I tried to make it this way, thank you for pointing.  I made another
commit for adding and using condition types (3 patches are attached
now).

Also I moved ‘process-query’ inside ‘with-error-handling’ (because I
used ‘raise’ there).  Could there be unwanted consequences after that?

> My apologies for being sloppy and not catching it earlier!

No problem at all.  I hope you catch something now if it is there.

>
> [...]
>
>> +              (('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)
>> +                     (format (current-error-port)
>> +                             "Cannot switch to generation '~a'~%" pattern)))
>
> Use ‘leave’ instead of ‘format’ here, with lower-case “cannot”.

Done.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-profiles-Add-condition-types-for-profile-and-generat.patch --]
[-- Type: text/x-diff, Size: 5004 bytes --]

From d5e9abb0395a21e79d4f77181597103d4daf138c Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 00:32:28 +0400
Subject: [PATCH 1/3] profiles: Add condition types for profile and generation.

* guix/profiles.scm (&profile-error, &generation-error): New condition types.
* guix/ui.scm (call-with-error-handling): Handle these types.
* guix/scripts/package.scm (roll-back, guix-package): Raise '&profile-error'
  where needed.
---
 guix/profiles.scm        | 24 +++++++++++++++++++++++-
 guix/scripts/package.scm | 15 +++++++--------
 guix/ui.scm              |  7 +++++++
 3 files changed, 37 insertions(+), 9 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 18733a6..0e19d7a 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -35,7 +35,16 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
-  #:export (manifest make-manifest
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (&profile-error
+            profile-error?
+            profile-error-profile
+            &generation-error
+            generation-error?
+            generation-error-generation
+
+            manifest make-manifest
             manifest?
             manifest-entries
 
@@ -84,6 +93,19 @@
 
 \f
 ;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &profile-error &error
+  profile-error?
+  (profile profile-error-profile))
+
+(define-condition-type &generation-error &error
+  generation-error?
+  (generation generation-error-generation))
+
+\f
+;;;
 ;;; Manifests.
 ;;;
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fc9c37b..7e2143c 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -38,6 +38,8 @@
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
   #:use-module (gnu packages base)
@@ -109,8 +111,7 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
          (previous-number     (previous-generation-number profile number))
          (previous-generation (generation-file-name profile previous-number)))
     (cond ((not (file-exists? profile))                 ; invalid profile
-           (leave (_ "profile '~a' does not exist~%")
-                  profile))
+           (raise (condition (&profile-error (profile profile)))))
           ((zero? number)                               ; empty profile
            (format (current-error-port)
                    (_ "nothing to do: already at the empty profile~%")))
@@ -723,8 +724,7 @@ more information.~%"))
             (match-lambda
              (('delete-generations . pattern)
               (cond ((not (file-exists? profile)) ; XXX: race condition
-                     (leave (_ "profile '~a' does not exist~%")
-                            profile))
+                     (raise (condition (&profile-error (profile profile)))))
                     ((string-null? pattern)
                      (delete-generations
                       (%store) profile
@@ -833,8 +833,7 @@ more information.~%"))
              (newline)))
 
          (cond ((not (file-exists? profile)) ; XXX: race condition
-                (leave (_ "profile '~a' does not exist~%")
-                       profile))
+                (raise (condition (&profile-error (profile profile)))))
                ((string-null? pattern)
                 (for-each list-generation (profile-generations profile)))
                ((matching-generations pattern profile)
@@ -915,8 +914,8 @@ more information.~%"))
         (_ #f))))
 
   (let ((opts (parse-options)))
-    (or (process-query opts)
-        (with-error-handling
+    (with-error-handling
+      (or (process-query opts)
           (parameterize ((%store (open-connection)))
             (set-build-options-from-command-line (%store) opts)
 
diff --git a/guix/ui.scm b/guix/ui.scm
index 04345d4..9c0a5d2 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -23,6 +23,7 @@
   #:use-module (guix store)
   #:use-module (guix config)
   #:use-module (guix packages)
+  #:use-module (guix profiles)
   #:use-module (guix build-system)
   #:use-module (guix derivations)
   #:use-module ((guix build utils) #:select (mkdir-p))
@@ -229,6 +230,12 @@ interpreted."
                       (location->string loc)
                       (package-full-name package)
                       (build-system-name system))))
+            ((profile-error? c)
+             (leave (_ "profile '~a' does not exist~%")
+                    (profile-error-profile c)))
+            ((generation-error? c)
+             (leave (_ "generation '~a' does not exist~%")
+                    (generation-error-generation c)))
             ((nix-connection-error? c)
              (leave (_ "failed to connect to `~a': ~a~%")
                     (nix-connection-error-file c)
-- 
2.1.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-profiles-Add-procedures-for-switching-generations.patch --]
[-- Type: text/x-diff, Size: 4663 bytes --]

From e47644b43aaa73885ca648118b6fc59fdb499303 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 00:39:42 +0400
Subject: [PATCH 2/3] profiles: Add procedures for switching generations.

* guix/scripts/package.scm (switch-to-previous-generation): Move to...
* guix/profiles.scm: ... here. Use 'switch-to-generation'.
  (relative-generation): New procedure.
  (previous-generation-number): Use it.
  (switch-to-generation): New procedure.
---
 guix/profiles.scm        | 49 ++++++++++++++++++++++++++++++++++++++++--------
 guix/scripts/package.scm |  9 ---------
 2 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 0e19d7a..d064351 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -80,9 +80,12 @@
             generation-number
             generation-numbers
             profile-generations
+            relative-generation
             previous-generation-number
             generation-time
-            generation-file-name))
+            generation-file-name
+            switch-to-generation
+            switch-to-previous-generation))
 
 ;;; Commentary:
 ;;;
@@ -591,16 +594,28 @@ former profiles were found."
         '()
         generations)))
 
-(define (previous-generation-number profile number)
+(define* (relative-generation profile shift #:optional
+                              (current (generation-number profile)))
+  "Return PROFILE's generation shifted from the CURRENT generation by SHIFT.
+SHIFT is a positive or negative number.
+Return #f if there is no such generation."
+  (let* ((abs-shift (abs shift))
+         (numbers (profile-generations profile))
+         (from-current (memq current
+                             (if (negative? shift)
+                                 (reverse numbers)
+                                 numbers))))
+    (and from-current
+         (< abs-shift (length from-current))
+         (list-ref from-current abs-shift))))
+
+(define* (previous-generation-number profile #:optional
+                                     (number (generation-number profile)))
   "Return the number of the generation before generation NUMBER of
 PROFILE, or 0 if none exists.  It could be NUMBER - 1, but it's not the
 case when generations have been deleted (there are \"holes\")."
-  (fold (lambda (candidate highest)
-          (if (and (< candidate number) (> candidate highest))
-              candidate
-              highest))
-        0
-        (generation-numbers profile)))
+  (or (relative-generation profile -1 number)
+      0))
 
 (define (generation-file-name profile generation)
   "Return the file name for PROFILE's GENERATION."
@@ -611,4 +626,22 @@ case when generations have been deleted (there are \"holes\")."
   (make-time time-utc 0
              (stat:ctime (stat (generation-file-name profile number)))))
 
+(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-error (profile profile)))))
+          ((not (file-exists? generation))
+           (raise (condition (&generation-error (generation generation)))))
+          (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."
+  (switch-to-generation profile
+                        (previous-generation-number profile)))
+
 ;;; profiles.scm ends here
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 7e2143c..df8a7f2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -96,15 +96,6 @@ return PROFILE unchanged.  The goal is to treat '-p ~/.guix-profile' as if
 
     (switch-symlinks generation prof)))
 
-(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)))
-
 (define (roll-back store profile)
   "Roll back to the previous generation of PROFILE."
   (let* ((number              (generation-number profile))
-- 
2.1.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: 0003-guix-package-Add-switch-generation-option.patch --]
[-- Type: text/x-diff, Size: 6202 bytes --]

From 003e5c192796e8ea07491a94a85824a533155825 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 00:45:38 +0400
Subject: [PATCH 3/3] guix package: Add '--switch-generation' option.

* guix/scripts/package.scm: Add '--switch-generation' option.
  (guix-package): Adjust accordingly.
* tests/guix-package.sh: Test it.
* doc/guix.texi (Invoking guix package): Document it.
---
 doc/guix.texi            | 15 +++++++++++++++
 guix/scripts/package.scm | 35 ++++++++++++++++++++++++++++++-----
 tests/guix-package.sh    | 12 +++++++++++-
 3 files changed, 56 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index f6357bd..c6921b1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -784,6 +784,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 df8a7f2..0278f62 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -401,6 +401,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 (_ "
@@ -480,6 +483,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)
@@ -705,13 +712,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 9b0e75e..c01e914 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -86,6 +86,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"
@@ -100,6 +102,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
@@ -132,10 +140,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
-- 
2.1.2