Ludovic Courtès (2014-10-10 02:08 +0400) wrote:
> l...@gnu.org (Ludovic Courtès) skribis:
>
>> There’s:
>>
>> (guix store) -> (guix nar) -> (guix ui) -> (guix store) ...
>
> Commit 0363991 fixes that.
>
> (Now we must make sure we don’t reintroduce cycles in these modules;
> probably we should integrate Mark’s cycle detection script somehow.)
>
> With that I was able to apply the patch you posted.
>
> Thanks, and sorry for the mess!
Thank you for fixing that and sorry that I didn't reply to you on #guix
yesterday (I was away).
Now there shouldn't be problems with adding new condition types to (guix
profiles). The patch is attached and “make check” was successful on
that. 2 little questions:
1. As you suggested I made a hierarchy of conditions:
> 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?
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
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? Perhaps it would be better to move ‘switch-symlinks’ and
all ‘_’, ‘N_’, … stuff to (guix utils)? But what do I know, it's up to
you again (I feel guilty that I have to bother you again).
>From af9d9869f2430dd3e20885e685867c6843ba4279 Mon Sep 17 00:00:00 2001
From: Alex Kost <alez...@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 | 7 +++++++
3 files changed, 45 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 @@
;;;
+;;; 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))
+
+
+;;;
;;; 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..feeb10e 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <l...@gnu.org>
;;; Copyright © 2013 Mark H Weaver <m...@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nik...@karetnikov.org>
+;;; Copyright © 2014 Alex Kost <alez...@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -231,6 +232,12 @@ 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 does not exist~%")
+ (missing-generation-error-generation c)))
((nix-connection-error? c)
(leave (_ "failed to connect to `~a': ~a~%")
(nix-connection-error-file c)
--
2.1.2
>From da49a2b7af5295c3c72b7e4590219cbac827877b 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 | 51 ++++++++++++++++++++++++++++++++++++++++--------
guix/scripts/package.scm | 9 ---------
2 files changed, 43 insertions(+), 17 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 793af24..f56e407 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:
;;;
@@ -503,16 +506,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."
@@ -523,4 +538,24 @@ 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-not-found-error
+ (profile profile)))))
+ ((not (file-exists? generation))
+ (raise (condition (&missing-generation-error
+ (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."
+ (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 ab9d303..460416f 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
