Ludovic Courtès (2014-10-06 23:27 +0400) wrote:

> Alex Kost <alez...@gmail.com> skribis:
>
>> A patch is attached.  Some comments:
>>
>> - ‘shitted-generation’ is not a very good name, I think.  Ideas?
>
> ‘shifted-generation’ is better :-), but otherwise maybe
> ‘relative-generation’?  No strong opinion.

I like ‘relative-generation’, thanks.

>> - ‘previous-generation-number’ may use ‘shifted-generation’ now:
>>
>> (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\")."
>>   (or (shifted-generation profile -1 number)
>>       0))
>>
>>   Worth changing?
>
> Yes, why not.

Done.

>> - Perhaps it would be better to make 2 commits (?): one for adding
>>   ‘shifted-generation’ and ‘switch-to-generation’ procedures to (guix
>>   profiles) and another is for adding the “--switch-generation” option
>>   itself.
>
> Yes.

Done.

>> - Also I made a couple of cosmetic changes in “guix/scripts/package.scm”:
>>   * ‘filter-map’ was replaced by 'for-each' because it was called only for
>>     side effects there;
>>   * ‘begin’ was removed from ‘cond’.
>>   I think these changes do not deserve a separate commit and may stay in
>>   this patch.  Is it OK?
>
> Several patches make it easier to reason about the changes, but it’s OK
> here.  Your call.

OK, thanks, I left those changes.

>> From 3cc52d1aade5e9723c38c0af5fa4437cbdf1a9b6 Mon Sep 17 00:00:00 2001
>> From: Alex Kost <alez...@gmail.com>
>> Date: Mon, 6 Oct 2014 17:35:51 +0400
>> Subject: [PATCH] guix package: Add '--switch-generation' option.
>>
>> * doc/guix.texi (Invoking guix package): Update documentation.
>> * guix/profiles.scm (shifted-generation, switch-to-generation): New
>>   procedures.
>> * guix/scripts/package.scm: Add '--switch-generation' option.
>>   (switch-to-previous-generation): Use 'switch-to-generation'.
>
> Could you add a test in tests/guix-package.sh?
>
> The rest looks good to me, thanks for working on it!

Thanks, I've added a couple of tests.  The new patches are attached.
Further improvements (documentation may be unsatisfactory)?

>From 9493421a4e094be6686ff6f28749946d491f81cd Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@gmail.com>
Date: Tue, 7 Oct 2014 11:50:44 +0400
Subject: [PATCH 1/2] 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        | 53 ++++++++++++++++++++++++++++++++++++++++--------
 guix/scripts/package.scm |  9 --------
 2 files changed, 45 insertions(+), 17 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 18733a6..9920881 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -71,9 +71,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:
 ;;;
@@ -569,16 +572,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."
@@ -589,4 +604,26 @@ 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))
+        (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)))))
+
+(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 fc9c37b..d0f1458 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -94,15 +94,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

>From 0d89e5466741d8f80a1ac27502cb6cd600afb796 Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@gmail.com>
Date: Tue, 7 Oct 2014 12:05:06 +0400
Subject: [PATCH 2/2] 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    | 14 +++++++++++++-
 3 files changed, 58 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 d0f1458..4a4417e 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -400,6 +400,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 (_ "
@@ -479,6 +482,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)
@@ -704,13 +711,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)
+                     (format (current-error-port)
+                             "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..5ad0873 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -100,6 +100,16 @@ 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"
+
+    # Switching to a non-existing generation does not change the current one.
+    guix package -p "$profile" --switch-generation=99
+    test "`readlink_base "$profile"`" = "$profile-1-link"
+
     # Move to the empty profile.
     for i in `seq 1 3`
     do
@@ -132,10 +142,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

Reply via email to