Re: ui: Move 'show-manifest-transaction' from (guix profiles).

[Alex Kost <alezost@gmail.com>]

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

Ludovic Courtès (2014-10-10 16:15 +0400) wrote:

> Alex Kost <alezost@gmail.com> skribis:
>
>> Ludovic Courtès (2014-10-10 02:08 +0400) wrote:
>
> [...]
>
>>> This is bikeshedding, but I would make a hierarchy like this:
>>>
>>>                      &profile-error, with ‘profile’ field
>>>                             ^
>>>            .———————————————–+———————————————–.
>>>            |                                 |
>>>   &profile-not-found-error        &missing-generation-error, with ‘generation’ field
>>
>> Thank you for the idea btw, I like it.  So the question is: should the
>> parent &profile-error be handled as well?  If yes, what message to use?
>
> Let’s ignore it for now, it Shouldn’t Happen™.

OK, that's what I thought.

>> 2. And another question: the current error for generation would look
>> like this:
>>
>>   generation 18 does not exist
>>
>> Is it OK or should I use ‘generation-file-name’ there and make it:
>>
>>   generation '/some/path/to/profile/generation-18-link' does not exist
>
> I prefer “generation 18 does not exist”, or maybe “generation 18 of
> ‘/some/profile’ does not exist”.  WDYT?

I agree, mentioning a profile would be better.  I modified the patch for
that.

>> The problem now is I can't add ‘switch-to-generation’ procedure to (guix
>> profiles) as it uses ‘_’ and ‘switch-symlinks’ from (guix ui) which is
>> not “#:use-module”-ed anymore.  This patch is also attached.  What to do
>> about it?  I think moving ‘switch-to-generation’ to (guix ui) is not
>> good or is it?
>
> Yeah, a you suggested on IRC, let’s just leave it in (guix scripts
> package) until we have a better idea.  :-)
[...]

OK, I have not pushed anything yet, as the commits were changed a bit.
I'm attaching all 3 patches for adding “Switch to generation” support.
Everything seems OK now (at least “make check” does not fail anymore),
so if you don't have final comments, I would like to commit them.
Thanks for the patience.


[-- Attachment #2: 0001-profiles-Add-condition-types-for-profiles-and-genera.patch --]
[-- Type: text/x-diff, Size: 5822 bytes --]

From 899165ece24d597a1e3c52cc417eb08e7438b061 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 17:29:01 +0400
Subject: [PATCH 1/3] profiles: Add condition types for profiles and
 generations.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Suggested by Ludovic Courtès.

* guix/profiles.scm (&profile-error, &profile-not-found-error,
  &missing-generation-error): New condition types.
* guix/ui.scm (call-with-error-handling): Handle new types.
* guix/scripts/package.scm (roll-back, guix-package): Raise
  '&profile-not-found-error' where needed.
---
 guix/profiles.scm        | 29 ++++++++++++++++++++++++++++-
 guix/scripts/package.scm | 18 ++++++++++--------
 guix/ui.scm              |  8 ++++++++
 3 files changed, 46 insertions(+), 9 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index f2eb754..793af24 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -34,7 +34,18 @@
   #: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
+            &profile-not-found-error
+            profile-not-found-error?
+            &missing-generation-error
+            missing-generation-error?
+            missing-generation-error-generation
+
+            manifest make-manifest
             manifest?
             manifest-entries
 
@@ -82,6 +93,22 @@
 
 \f
 ;;;
+;;; Condition types.
+;;;
+
+(define-condition-type &profile-error &error
+  profile-error?
+  (profile profile-error-profile))
+
+(define-condition-type &profile-not-found-error &profile-error
+  profile-not-found-error?)
+
+(define-condition-type &missing-generation-error &profile-error
+  missing-generation-error?
+  (generation missing-generation-error-generation))
+
+\f
+;;;
 ;;; Manifests.
 ;;;
 
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 031f71a..ab9d303 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,8 @@ 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-not-found-error
+                              (profile profile)))))
           ((zero? number)                               ; empty profile
            (format (current-error-port)
                    (_ "nothing to do: already at the empty profile~%")))
@@ -723,8 +725,8 @@ 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-not-found-error
+                                        (profile profile)))))
                     ((string-null? pattern)
                      (delete-generations
                       (%store) profile
@@ -833,8 +835,8 @@ more information.~%"))
              (newline)))
 
          (cond ((not (file-exists? profile)) ; XXX: race condition
-                (leave (_ "profile '~a' does not exist~%")
-                       profile))
+                (raise (condition (&profile-not-found-error
+                                   (profile profile)))))
                ((string-null? pattern)
                 (for-each list-generation (profile-generations profile)))
                ((matching-generations pattern profile)
@@ -915,8 +917,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 8c4a9d2..69b073d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -231,6 +232,13 @@ interpreted."
                       (location->string loc)
                       (package-full-name package)
                       (build-system-name system))))
+            ((profile-not-found-error? c)
+             (leave (_ "profile '~a' does not exist~%")
+                    (profile-error-profile c)))
+            ((missing-generation-error? c)
+             (leave (_ "generation ~a of profile '~a' does not exist~%")
+                    (missing-generation-error-generation c)
+                    (profile-error-profile 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-relative-generation.patch --]
[-- Type: text/x-diff, Size: 2328 bytes --]

From ab9b871a5a5b7849e543ebdc9a6efb915a7b8aca Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Fri, 10 Oct 2014 17:56:59 +0400
Subject: [PATCH 2/3] profiles: Add 'relative-generation'.

* guix/profiles.scm: (relative-generation): New procedure.
  (previous-generation-number): Use it.
---
 guix/profiles.scm | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 793af24..2742ba8 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -80,6 +80,7 @@
             generation-number
             generation-numbers
             profile-generations
+            relative-generation
             previous-generation-number
             generation-time
             generation-file-name))
@@ -503,16 +504,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."
-- 
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: 8157 bytes --]

From 256652b0da5a69c23e2ca164c884197715a8a495 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Fri, 10 Oct 2014 17:58:43 +0400
Subject: [PATCH 3/3] 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.
---
 doc/guix.texi            | 15 ++++++++++++
 guix/scripts/package.scm | 61 +++++++++++++++++++++++++++++++++++++++---------
 tests/guix-package.sh    | 12 +++++++++-
 3 files changed, 76 insertions(+), 12 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 5881adb..b61d526 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -797,6 +797,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 ab9d303..3a72053 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 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