Ludovic Courtès (2014-10-07 20:00 +0400) wrote:
> Alex Kost <alez...@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.
>From d5e9abb0395a21e79d4f77181597103d4daf138c Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@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 @@
;;;
+;;; 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))
+
+
+;;;
;;; 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
>From e47644b43aaa73885ca648118b6fc59fdb499303 Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@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
>From 003e5c192796e8ea07491a94a85824a533155825 Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@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
