* ui: Move 'show-manifest-transaction' from (guix profiles).
@ 2014-10-08 14:19 Alex Kost
2014-10-08 17:57 ` Alex Kost
2014-10-08 19:55 ` Ludovic Courtès
0 siblings, 2 replies; 12+ messages in thread
From: Alex Kost @ 2014-10-08 14:19 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: guix-devel
[-- Attachment #1: Type: text/plain, Size: 385 bytes --]
Hello, I tried to move (and rename for consistency with other ‘show-…’
procedures) ‘manifest-show-transaction’ from (guix profiles) to (guix
ui) as we were discussing on #guix today, but I found that tests began
to fail. And I can't figure it out. The first failed test is
"builders.scm". Its log and the patch with the changes I made are
attached.
Need help :(
[-- Attachment #2: 0001-ui-Move-show-manifest-transaction-from-guix-profiles.patch --]
[-- Type: text/x-diff, Size: 15825 bytes --]
From bc27ebd215a16c52d434245bd618b10262fa9562 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Wed, 8 Oct 2014 17:15:49 +0400
Subject: [PATCH] ui: Move 'show-manifest-transaction' from (guix profiles).
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Suggested by Ludovic Courtès.
* guix/profiles.scm: Do not use (guix ui) module.
(right-arrow, manifest-show-transaction): Move and rename to...
* guix/ui.scm (right-arrow, show-manifest-transaction): ... here.
* tests/profiles.scm ("manifest-show-transaction"): Move to...
* tests/ui.scm ("show-manifest-transaction"): ... here.
(guile-1.8.8, guile-2.0.9): New variables.
* emacs/guix-main.scm (process-package-actions): Rename
'manifest-show-transaction' to 'show-manifest-transaction'.
* guix/scripts/package.scm (guix-package): Likewise.
---
emacs/guix-main.scm | 2 +-
guix/profiles.scm | 93 ------------------------------------------------
guix/scripts/package.scm | 2 +-
guix/ui.scm | 93 ++++++++++++++++++++++++++++++++++++++++++++++++
tests/profiles.scm | 17 ---------
tests/ui.scm | 32 +++++++++++++++++
6 files changed, 127 insertions(+), 112 deletions(-)
diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm
index 7dbfa61..c25dd50 100644
--- a/emacs/guix-main.scm
+++ b/emacs/guix-main.scm
@@ -797,7 +797,7 @@ OUTPUTS is a list of package outputs (may be an empty list)."
(new-profile (derivation->output-path derivation)))
(set-build-options store
#:use-substitutes? use-substitutes?)
- (manifest-show-transaction store manifest transaction
+ (show-manifest-transaction store manifest transaction
#:dry-run? dry-run?)
(show-what-to-build store derivations
#:use-substitutes? use-substitutes?
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 18733a6..f2eb754 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -19,7 +19,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix profiles)
- #:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix records)
#:use-module (guix derivations)
@@ -63,7 +62,6 @@
manifest-transaction-remove
manifest-perform-transaction
manifest-transaction-effects
- manifest-show-transaction
profile-manifest
package->manifest-entry
@@ -315,97 +313,6 @@ it."
(manifest-add (manifest-remove manifest remove)
install)))
-(define (right-arrow port)
- "Return either a string containing the 'RIGHT ARROW' character, or an ASCII
-replacement if PORT is not Unicode-capable."
- (with-fluids ((%default-port-encoding (port-encoding port)))
- (let ((arrow "→"))
- (catch 'encoding-error
- (lambda ()
- (call-with-output-string
- (lambda (port)
- (set-port-conversion-strategy! port 'error)
- (display arrow port))))
- (lambda (key . args)
- "->")))))
-
-(define* (manifest-show-transaction store manifest transaction
- #:key dry-run?)
- "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
- (define (package-strings name version output item)
- (map (lambda (name version output item)
- (format #f " ~a~:[:~a~;~*~]\t~a\t~a"
- name
- (equal? output "out") output version
- (if (package? item)
- (package-output store item output)
- item)))
- name version output item))
-
- (define → ;an arrow that can be represented on stderr
- (right-arrow (current-error-port)))
-
- (define (upgrade-string name old-version new-version output item)
- (format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a"
- name (equal? output "out") output
- old-version → new-version
- (if (package? item)
- (package-output store item output)
- item)))
-
- (let-values (((remove install upgrade)
- (manifest-transaction-effects manifest transaction)))
- (match remove
- ((($ <manifest-entry> name version output item) ..1)
- (let ((len (length name))
- (remove (package-strings name version output item)))
- (if dry-run?
- (format (current-error-port)
- (N_ "The following package would be removed:~%~{~a~%~}~%"
- "The following packages would be removed:~%~{~a~%~}~%"
- len)
- remove)
- (format (current-error-port)
- (N_ "The following package will be removed:~%~{~a~%~}~%"
- "The following packages will be removed:~%~{~a~%~}~%"
- len)
- remove))))
- (_ #f))
- (match upgrade
- (((($ <manifest-entry> name old-version)
- . ($ <manifest-entry> _ new-version output item)) ..1)
- (let ((len (length name))
- (upgrade (map upgrade-string
- name old-version new-version output item)))
- (if dry-run?
- (format (current-error-port)
- (N_ "The following package would be upgraded:~%~{~a~%~}~%"
- "The following packages would be upgraded:~%~{~a~%~}~%"
- len)
- upgrade)
- (format (current-error-port)
- (N_ "The following package will be upgraded:~%~{~a~%~}~%"
- "The following packages will be upgraded:~%~{~a~%~}~%"
- len)
- upgrade))))
- (_ #f))
- (match install
- ((($ <manifest-entry> name version output item _) ..1)
- (let ((len (length name))
- (install (package-strings name version output item)))
- (if dry-run?
- (format (current-error-port)
- (N_ "The following package would be installed:~%~{~a~%~}~%"
- "The following packages would be installed:~%~{~a~%~}~%"
- len)
- install)
- (format (current-error-port)
- (N_ "The following package will be installed:~%~{~a~%~}~%"
- "The following packages will be installed:~%~{~a~%~}~%"
- len)
- install))))
- (_ #f))))
-
\f
;;;
;;; Profiles.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index fc9c37b..031f71a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -770,7 +770,7 @@ more information.~%"))
new
#:info-dir? (not bootstrap?))))
(prof (derivation->output-path prof-drv)))
- (manifest-show-transaction (%store) manifest transaction
+ (show-manifest-transaction (%store) manifest transaction
#:dry-run? dry-run?)
(show-what-to-build (%store) (list prof-drv)
#:use-substitutes?
diff --git a/guix/ui.scm b/guix/ui.scm
index 04345d4..9778dca 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))
@@ -47,6 +48,7 @@
string->number*
size->number
show-what-to-build
+ show-manifest-transaction
call-with-error-handling
with-error-handling
read/eval
@@ -347,6 +349,97 @@ available for download."
(null? download) download)))
(pair? build)))
+(define (right-arrow port)
+ "Return either a string containing the 'RIGHT ARROW' character, or an ASCII
+replacement if PORT is not Unicode-capable."
+ (with-fluids ((%default-port-encoding (port-encoding port)))
+ (let ((arrow "→"))
+ (catch 'encoding-error
+ (lambda ()
+ (call-with-output-string
+ (lambda (port)
+ (set-port-conversion-strategy! port 'error)
+ (display arrow port))))
+ (lambda (key . args)
+ "->")))))
+
+(define* (show-manifest-transaction store manifest transaction
+ #:key dry-run?)
+ "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
+ (define (package-strings name version output item)
+ (map (lambda (name version output item)
+ (format #f " ~a~:[:~a~;~*~]\t~a\t~a"
+ name
+ (equal? output "out") output version
+ (if (package? item)
+ (package-output store item output)
+ item)))
+ name version output item))
+
+ (define → ;an arrow that can be represented on stderr
+ (right-arrow (current-error-port)))
+
+ (define (upgrade-string name old-version new-version output item)
+ (format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a"
+ name (equal? output "out") output
+ old-version → new-version
+ (if (package? item)
+ (package-output store item output)
+ item)))
+
+ (let-values (((remove install upgrade)
+ (manifest-transaction-effects manifest transaction)))
+ (match remove
+ ((($ <manifest-entry> name version output item) ..1)
+ (let ((len (length name))
+ (remove (package-strings name version output item)))
+ (if dry-run?
+ (format (current-error-port)
+ (N_ "The following package would be removed:~%~{~a~%~}~%"
+ "The following packages would be removed:~%~{~a~%~}~%"
+ len)
+ remove)
+ (format (current-error-port)
+ (N_ "The following package will be removed:~%~{~a~%~}~%"
+ "The following packages will be removed:~%~{~a~%~}~%"
+ len)
+ remove))))
+ (_ #f))
+ (match upgrade
+ (((($ <manifest-entry> name old-version)
+ . ($ <manifest-entry> _ new-version output item)) ..1)
+ (let ((len (length name))
+ (upgrade (map upgrade-string
+ name old-version new-version output item)))
+ (if dry-run?
+ (format (current-error-port)
+ (N_ "The following package would be upgraded:~%~{~a~%~}~%"
+ "The following packages would be upgraded:~%~{~a~%~}~%"
+ len)
+ upgrade)
+ (format (current-error-port)
+ (N_ "The following package will be upgraded:~%~{~a~%~}~%"
+ "The following packages will be upgraded:~%~{~a~%~}~%"
+ len)
+ upgrade))))
+ (_ #f))
+ (match install
+ ((($ <manifest-entry> name version output item _) ..1)
+ (let ((len (length name))
+ (install (package-strings name version output item)))
+ (if dry-run?
+ (format (current-error-port)
+ (N_ "The following package would be installed:~%~{~a~%~}~%"
+ "The following packages would be installed:~%~{~a~%~}~%"
+ len)
+ install)
+ (format (current-error-port)
+ (N_ "The following package will be installed:~%~{~a~%~}~%"
+ "The following packages will be installed:~%~{~a~%~}~%"
+ len)
+ install))))
+ (_ #f))))
+
(define-syntax with-error-handling
(syntax-rules ()
"Run BODY within a user-friendly error condition handler."
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 99f1fd2..61c801c 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -156,23 +156,6 @@
(equal? (list glibc) install)
(equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade)))))
-(test-assert "manifest-show-transaction"
- (let* ((m (manifest (list guile-1.8.8)))
- (t (manifest-transaction (install (list guile-2.0.9)))))
- (let-values (((remove install upgrade)
- (manifest-transaction-effects m t)))
- (with-store store
- (and (string-match "guile\t1.8.8 → 2.0.9"
- (with-fluids ((%default-port-encoding "UTF-8"))
- (with-error-to-string
- (lambda ()
- (manifest-show-transaction store m t)))))
- (string-match "guile\t1.8.8 -> 2.0.9"
- (with-fluids ((%default-port-encoding "ISO-8859-1"))
- (with-error-to-string
- (lambda ()
- (manifest-show-transaction store m t))))))))))
-
(test-assert "profile-derivation"
(run-with-store %store
(mlet* %store-monad
diff --git a/tests/ui.scm b/tests/ui.scm
index db90cdd..ed4cd06 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -19,6 +19,7 @@
(define-module (test-ui)
#:use-module (guix ui)
+ #:use-module (guix profiles)
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (srfi srfi-1)
@@ -35,6 +36,20 @@ R6RS, Guile includes a module system, full access to POSIX system calls,
networking support, multiple threads, dynamic linking, a foreign function call
interface, and powerful string processing.")
+(define guile-1.8.8
+ (manifest-entry
+ (name "guile")
+ (version "1.8.8")
+ (item "/gnu/store/...")
+ (output "out")))
+
+(define guile-2.0.9
+ (manifest-entry
+ (name "guile")
+ (version "2.0.9")
+ (item "/gnu/store/...")
+ (output "out")))
+
\f
(test-begin "ui")
@@ -210,6 +225,23 @@ Second line" 24))
;; This should print nothing.
(show-what-to-build store (list drv)))))))
+(test-assert "show-manifest-transaction"
+ (let* ((m (manifest (list guile-1.8.8)))
+ (t (manifest-transaction (install (list guile-2.0.9)))))
+ (let-values (((remove install upgrade)
+ (manifest-transaction-effects m t)))
+ (with-store store
+ (and (string-match "guile\t1.8.8 → 2.0.9"
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (with-error-to-string
+ (lambda ()
+ (show-manifest-transaction store m t)))))
+ (string-match "guile\t1.8.8 -> 2.0.9"
+ (with-fluids ((%default-port-encoding "ISO-8859-1"))
+ (with-error-to-string
+ (lambda ()
+ (show-manifest-transaction store m t))))))))))
+
(test-end "ui")
\f
--
2.1.2
[-- Attachment #3: builders.log --]
[-- Type: text/plain, Size: 1633 bytes --]
Backtrace:
In ice-9/boot-9.scm:
3065: 19 [try-module-autoload (guix profiles) #f]
2401: 18 [save-module-excursion #<procedure 9763f00 at ice-9/boot-9.scm:3066:17 ()>]
3085: 17 [#<procedure 9763f00 at ice-9/boot-9.scm:3066:17 ()>]
In unknown file:
?: 16 [primitive-load-path "guix/profiles" ...]
In guix/profiles.scm:
21: 15 [#<procedure 9776070 ()>]
In ice-9/boot-9.scm:
2951: 14 [define-module* (guix profiles) #:filename ...]
2926: 13 [resolve-imports (((guix utils)) ((guix records)) ((guix derivations)) ...)]
2864: 12 [resolve-interface (guix gexp) #:select ...]
2789: 11 [#<procedure 944b300 at ice-9/boot-9.scm:2777:4 (name #:optional autoload version #:key ensure)> # ...]
3065: 10 [try-module-autoload (guix gexp) #f]
2401: 9 [save-module-excursion #<procedure 977a630 at ice-9/boot-9.scm:3066:17 ()>]
3085: 8 [#<procedure 977a630 at ice-9/boot-9.scm:3066:17 ()>]
In unknown file:
?: 7 [primitive-load-path "guix/gexp" ...]
In guix/gexp.scm:
19: 6 [#<procedure 97870d0 ()>]
In ice-9/boot-9.scm:
2951: 5 [define-module* (guix gexp) #:filename ...]
2926: 4 [resolve-imports ((# # #) (#) (# # #) (#) ...)]
2877: 3 [resolve-interface (guix store) #:select ...]
768: 2 [for-each #<procedure 96f5640 at ice-9/boot-9.scm:2877:20 (bspec)> #]
2883: 1 [#<procedure 96f5640 at ice-9/boot-9.scm:2877:20 (bspec)> direct-store-path?]
In unknown file:
?: 0 [scm-error misc-error #f ...]
ERROR: In procedure scm-error:
ERROR: no binding `direct-store-path?' in module (guix store)
./test-env: line 1: 28447 Terminated "/media/storage/src/guix/pre-inst-env" "/media/storage/src/guix/guix-daemon" --disable-chroot
[-- Attachment #4: Type: text/plain, Size: 17 bytes --]
--
Thanks,
Alex
^ permalink raw reply related [flat|nested] 12+ messages in thread* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-08 14:19 ui: Move 'show-manifest-transaction' from (guix profiles) Alex Kost @ 2014-10-08 17:57 ` Alex Kost 2014-10-08 19:55 ` Ludovic Courtès 1 sibling, 0 replies; 12+ messages in thread From: Alex Kost @ 2014-10-08 17:57 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 286 bytes --] Sorry, I've found that the patch I sent is not cleanly applied to the latest master checkout. The modified patch is attached. It seems the fail happens only if there is #:use-module (guix profiles) in (guix ui). If (guix profiles) is not used, there are no problems. I'm stuck. [-- Attachment #2: 0001-ui-Move-show-manifest-transaction-from-guix-profiles.patch --] [-- Type: text/x-diff, Size: 15714 bytes --] From 480c22f37437ce138d4fe822f5b1c15f1f65be0e Mon Sep 17 00:00:00 2001 From: Alex Kost <alezost@gmail.com> Date: Wed, 8 Oct 2014 17:15:49 +0400 Subject: [PATCH] ui: Move 'show-manifest-transaction' from (guix profiles). * guix/profiles.scm: Do not use (guix ui) module. (right-arrow, manifest-show-transaction): Move and rename to... * guix/ui.scm (right-arrow, show-manifest-transaction): ... here. * tests/profiles.scm ("manifest-show-transaction"): Move to... * tests/ui.scm ("show-manifest-transaction"): ... here. (guile-1.8.8, guile-2.0.9): New variables. * emacs/guix-main.scm (process-package-actions): Rename 'manifest-show-transaction' to 'show-manifest-transaction'. * guix/scripts/package.scm (guix-package): Likewise. --- emacs/guix-main.scm | 2 +- guix/profiles.scm | 93 ------------------------------------------------ guix/scripts/package.scm | 2 +- guix/ui.scm | 93 ++++++++++++++++++++++++++++++++++++++++++++++++ tests/profiles.scm | 17 --------- tests/ui.scm | 32 +++++++++++++++++ 6 files changed, 127 insertions(+), 112 deletions(-) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index b85bb5c..fe599fb 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -797,7 +797,7 @@ OUTPUTS is a list of package outputs (may be an empty list)." (new-profile (derivation->output-path derivation))) (set-build-options store #:use-substitutes? use-substitutes?) - (manifest-show-transaction store manifest transaction + (show-manifest-transaction store manifest transaction #:dry-run? dry-run?) (show-what-to-build store derivations #:use-substitutes? use-substitutes? diff --git a/guix/profiles.scm b/guix/profiles.scm index 18733a6..f2eb754 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -19,7 +19,6 @@ ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. (define-module (guix profiles) - #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix records) #:use-module (guix derivations) @@ -63,7 +62,6 @@ manifest-transaction-remove manifest-perform-transaction manifest-transaction-effects - manifest-show-transaction profile-manifest package->manifest-entry @@ -315,97 +313,6 @@ it." (manifest-add (manifest-remove manifest remove) install))) -(define (right-arrow port) - "Return either a string containing the 'RIGHT ARROW' character, or an ASCII -replacement if PORT is not Unicode-capable." - (with-fluids ((%default-port-encoding (port-encoding port))) - (let ((arrow "→")) - (catch 'encoding-error - (lambda () - (call-with-output-string - (lambda (port) - (set-port-conversion-strategy! port 'error) - (display arrow port)))) - (lambda (key . args) - "->"))))) - -(define* (manifest-show-transaction store manifest transaction - #:key dry-run?) - "Display what will/would be installed/removed from MANIFEST by TRANSACTION." - (define (package-strings name version output item) - (map (lambda (name version output item) - (format #f " ~a~:[:~a~;~*~]\t~a\t~a" - name - (equal? output "out") output version - (if (package? item) - (package-output store item output) - item))) - name version output item)) - - (define → ;an arrow that can be represented on stderr - (right-arrow (current-error-port))) - - (define (upgrade-string name old-version new-version output item) - (format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a" - name (equal? output "out") output - old-version → new-version - (if (package? item) - (package-output store item output) - item))) - - (let-values (((remove install upgrade) - (manifest-transaction-effects manifest transaction))) - (match remove - ((($ <manifest-entry> name version output item) ..1) - (let ((len (length name)) - (remove (package-strings name version output item))) - (if dry-run? - (format (current-error-port) - (N_ "The following package would be removed:~%~{~a~%~}~%" - "The following packages would be removed:~%~{~a~%~}~%" - len) - remove) - (format (current-error-port) - (N_ "The following package will be removed:~%~{~a~%~}~%" - "The following packages will be removed:~%~{~a~%~}~%" - len) - remove)))) - (_ #f)) - (match upgrade - (((($ <manifest-entry> name old-version) - . ($ <manifest-entry> _ new-version output item)) ..1) - (let ((len (length name)) - (upgrade (map upgrade-string - name old-version new-version output item))) - (if dry-run? - (format (current-error-port) - (N_ "The following package would be upgraded:~%~{~a~%~}~%" - "The following packages would be upgraded:~%~{~a~%~}~%" - len) - upgrade) - (format (current-error-port) - (N_ "The following package will be upgraded:~%~{~a~%~}~%" - "The following packages will be upgraded:~%~{~a~%~}~%" - len) - upgrade)))) - (_ #f)) - (match install - ((($ <manifest-entry> name version output item _) ..1) - (let ((len (length name)) - (install (package-strings name version output item))) - (if dry-run? - (format (current-error-port) - (N_ "The following package would be installed:~%~{~a~%~}~%" - "The following packages would be installed:~%~{~a~%~}~%" - len) - install) - (format (current-error-port) - (N_ "The following package will be installed:~%~{~a~%~}~%" - "The following packages will be installed:~%~{~a~%~}~%" - len) - install)))) - (_ #f)))) - \f ;;; ;;; Profiles. diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index fc9c37b..031f71a 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -770,7 +770,7 @@ more information.~%")) new #:info-dir? (not bootstrap?)))) (prof (derivation->output-path prof-drv))) - (manifest-show-transaction (%store) manifest transaction + (show-manifest-transaction (%store) manifest transaction #:dry-run? dry-run?) (show-what-to-build (%store) (list prof-drv) #:use-substitutes? diff --git a/guix/ui.scm b/guix/ui.scm index 04345d4..9778dca 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)) @@ -47,6 +48,7 @@ string->number* size->number show-what-to-build + show-manifest-transaction call-with-error-handling with-error-handling read/eval @@ -347,6 +349,97 @@ available for download." (null? download) download))) (pair? build))) +(define (right-arrow port) + "Return either a string containing the 'RIGHT ARROW' character, or an ASCII +replacement if PORT is not Unicode-capable." + (with-fluids ((%default-port-encoding (port-encoding port))) + (let ((arrow "→")) + (catch 'encoding-error + (lambda () + (call-with-output-string + (lambda (port) + (set-port-conversion-strategy! port 'error) + (display arrow port)))) + (lambda (key . args) + "->"))))) + +(define* (show-manifest-transaction store manifest transaction + #:key dry-run?) + "Display what will/would be installed/removed from MANIFEST by TRANSACTION." + (define (package-strings name version output item) + (map (lambda (name version output item) + (format #f " ~a~:[:~a~;~*~]\t~a\t~a" + name + (equal? output "out") output version + (if (package? item) + (package-output store item output) + item))) + name version output item)) + + (define → ;an arrow that can be represented on stderr + (right-arrow (current-error-port))) + + (define (upgrade-string name old-version new-version output item) + (format #f " ~a~:[:~a~;~*~]\t~a ~a ~a\t~a" + name (equal? output "out") output + old-version → new-version + (if (package? item) + (package-output store item output) + item))) + + (let-values (((remove install upgrade) + (manifest-transaction-effects manifest transaction))) + (match remove + ((($ <manifest-entry> name version output item) ..1) + (let ((len (length name)) + (remove (package-strings name version output item))) + (if dry-run? + (format (current-error-port) + (N_ "The following package would be removed:~%~{~a~%~}~%" + "The following packages would be removed:~%~{~a~%~}~%" + len) + remove) + (format (current-error-port) + (N_ "The following package will be removed:~%~{~a~%~}~%" + "The following packages will be removed:~%~{~a~%~}~%" + len) + remove)))) + (_ #f)) + (match upgrade + (((($ <manifest-entry> name old-version) + . ($ <manifest-entry> _ new-version output item)) ..1) + (let ((len (length name)) + (upgrade (map upgrade-string + name old-version new-version output item))) + (if dry-run? + (format (current-error-port) + (N_ "The following package would be upgraded:~%~{~a~%~}~%" + "The following packages would be upgraded:~%~{~a~%~}~%" + len) + upgrade) + (format (current-error-port) + (N_ "The following package will be upgraded:~%~{~a~%~}~%" + "The following packages will be upgraded:~%~{~a~%~}~%" + len) + upgrade)))) + (_ #f)) + (match install + ((($ <manifest-entry> name version output item _) ..1) + (let ((len (length name)) + (install (package-strings name version output item))) + (if dry-run? + (format (current-error-port) + (N_ "The following package would be installed:~%~{~a~%~}~%" + "The following packages would be installed:~%~{~a~%~}~%" + len) + install) + (format (current-error-port) + (N_ "The following package will be installed:~%~{~a~%~}~%" + "The following packages will be installed:~%~{~a~%~}~%" + len) + install)))) + (_ #f)))) + (define-syntax with-error-handling (syntax-rules () "Run BODY within a user-friendly error condition handler." diff --git a/tests/profiles.scm b/tests/profiles.scm index 99f1fd2..61c801c 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -156,23 +156,6 @@ (equal? (list glibc) install) (equal? (list (cons guile-1.8.8 guile-2.0.9)) upgrade))))) -(test-assert "manifest-show-transaction" - (let* ((m (manifest (list guile-1.8.8))) - (t (manifest-transaction (install (list guile-2.0.9))))) - (let-values (((remove install upgrade) - (manifest-transaction-effects m t))) - (with-store store - (and (string-match "guile\t1.8.8 → 2.0.9" - (with-fluids ((%default-port-encoding "UTF-8")) - (with-error-to-string - (lambda () - (manifest-show-transaction store m t))))) - (string-match "guile\t1.8.8 -> 2.0.9" - (with-fluids ((%default-port-encoding "ISO-8859-1")) - (with-error-to-string - (lambda () - (manifest-show-transaction store m t)))))))))) - (test-assert "profile-derivation" (run-with-store %store (mlet* %store-monad diff --git a/tests/ui.scm b/tests/ui.scm index db90cdd..ed4cd06 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -19,6 +19,7 @@ (define-module (test-ui) #:use-module (guix ui) + #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) #:use-module (srfi srfi-1) @@ -35,6 +36,20 @@ R6RS, Guile includes a module system, full access to POSIX system calls, networking support, multiple threads, dynamic linking, a foreign function call interface, and powerful string processing.") +(define guile-1.8.8 + (manifest-entry + (name "guile") + (version "1.8.8") + (item "/gnu/store/...") + (output "out"))) + +(define guile-2.0.9 + (manifest-entry + (name "guile") + (version "2.0.9") + (item "/gnu/store/...") + (output "out"))) + \f (test-begin "ui") @@ -210,6 +225,23 @@ Second line" 24)) ;; This should print nothing. (show-what-to-build store (list drv))))))) +(test-assert "show-manifest-transaction" + (let* ((m (manifest (list guile-1.8.8))) + (t (manifest-transaction (install (list guile-2.0.9))))) + (let-values (((remove install upgrade) + (manifest-transaction-effects m t))) + (with-store store + (and (string-match "guile\t1.8.8 → 2.0.9" + (with-fluids ((%default-port-encoding "UTF-8")) + (with-error-to-string + (lambda () + (show-manifest-transaction store m t))))) + (string-match "guile\t1.8.8 -> 2.0.9" + (with-fluids ((%default-port-encoding "ISO-8859-1")) + (with-error-to-string + (lambda () + (show-manifest-transaction store m t)))))))))) + (test-end "ui") \f -- 2.1.2 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-08 14:19 ui: Move 'show-manifest-transaction' from (guix profiles) Alex Kost 2014-10-08 17:57 ` Alex Kost @ 2014-10-08 19:55 ` Ludovic Courtès 2014-10-09 6:31 ` Alex Kost 2014-10-09 22:08 ` Ludovic Courtès 1 sibling, 2 replies; 12+ messages in thread From: Ludovic Courtès @ 2014-10-08 19:55 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel Alex Kost <alezost@gmail.com> skribis: > ?: 16 [primitive-load-path "guix/profiles" ...] > In guix/profiles.scm: > 21: 15 [#<procedure 9776070 ()>] > In ice-9/boot-9.scm: > 2951: 14 [define-module* (guix profiles) #:filename ...] > 2926: 13 [resolve-imports (((guix utils)) ((guix records)) ((guix derivations)) ...)] > 2864: 12 [resolve-interface (guix gexp) #:select ...] > 2789: 11 [#<procedure 944b300 at ice-9/boot-9.scm:2777:4 (name #:optional autoload version #:key ensure)> # ...] > 3065: 10 [try-module-autoload (guix gexp) #f] > 2401: 9 [save-module-excursion #<procedure 977a630 at ice-9/boot-9.scm:3066:17 ()>] > 3085: 8 [#<procedure 977a630 at ice-9/boot-9.scm:3066:17 ()>] > In unknown file: > ?: 7 [primitive-load-path "guix/gexp" ...] > In guix/gexp.scm: > 19: 6 [#<procedure 97870d0 ()>] > In ice-9/boot-9.scm: > 2951: 5 [define-module* (guix gexp) #:filename ...] > 2926: 4 [resolve-imports ((# # #) (#) (# # #) (#) ...)] > 2877: 3 [resolve-interface (guix store) #:select ...] > 768: 2 [for-each #<procedure 96f5640 at ice-9/boot-9.scm:2877:20 (bspec)> #] > 2883: 1 [#<procedure 96f5640 at ice-9/boot-9.scm:2877:20 (bspec)> direct-store-path?] > In unknown file: > ?: 0 [scm-error misc-error #f ...] > > ERROR: In procedure scm-error: > ERROR: no binding `direct-store-path?' in module (guix store) This is another circularity issue. :-/ There’s: (guix store) -> (guix nar) -> (guix ui) -> (guix store) ... This shouldn’t be a problem, except that occasional uses of #:select trigger a bug (see <http://bugs.gnu.org/15540>.) I’ve fiddled a bit on top of your patch, but couldn’t find any simple fix. However, back to the initial problem, is this a problem if the error conditions are defined in (guix profiles), which is then imported by (guix ui)? This is suboptimal, but this kind of circular reference shouldn’t cause any troubles. HTH, Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-08 19:55 ` Ludovic Courtès @ 2014-10-09 6:31 ` Alex Kost 2014-10-09 21:03 ` Ludovic Courtès 2014-10-09 22:08 ` Ludovic Courtès 1 sibling, 1 reply; 12+ messages in thread From: Alex Kost @ 2014-10-09 6:31 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 1188 bytes --] Ludovic Courtès (2014-10-08 23:55 +0400) wrote: > Alex Kost <alezost@gmail.com> skribis: [...] > This is another circularity issue. :-/ > > There’s: > > (guix store) -> (guix nar) -> (guix ui) -> (guix store) ... > > This shouldn’t be a problem, except that occasional uses of #:select > trigger a bug (see <http://bugs.gnu.org/15540>.) Ouch, thanks for the explanation. > I’ve fiddled a bit on top of your patch, but couldn’t find any simple > fix. > > However, back to the initial problem, is this a problem if the error > conditions are defined in (guix profiles), which is then imported by > (guix ui)? This is suboptimal, but this kind of circular reference > shouldn’t cause any troubles. Do you mean to "#:select" condition types in (guix ui)? I tried but it failed for me even on “make” (the patch I tried and the make output are attached). So it looks like even selecting from (guix profile) won't work in (guix ui) or did I miss something? What about making an auxiliary (guix conditions) module with all existing condition types, and use it where needed? I could try to work on it if it sounds reasonable. WDYT? [-- Attachment #2: 0001-profiles-Add-condition-types-for-profiles-and-genera.patch --] [-- Type: text/x-diff, Size: 6162 bytes --] From 6b1c3edea51abb464f4265f36f25c5e314731ac2 Mon Sep 17 00:00:00 2001 From: Alex Kost <alezost@gmail.com> Date: Wed, 8 Oct 2014 17:29:01 +0400 Subject: [PATCH] profiles: Add condition types for profiles and generations. * 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 | 12 ++++++++++++ 3 files changed, 50 insertions(+), 9 deletions(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index 18733a6..b1fa50e 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -35,7 +35,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 @@ -84,6 +95,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 fc9c37b..9f3ed3a 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 04345d4..55a8105 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. ;;; @@ -27,6 +28,11 @@ #:use-module (guix derivations) #:use-module ((guix build utils) #:select (mkdir-p)) #:use-module ((guix licenses) #:select (license? license-name)) + #:use-module ((guix profiles) + #:select (profile-not-found-error? + profile-error-profile + missing-generation-error? + missing-generation-error-generation)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -229,6 +235,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 [-- Attachment #3: guix-make-fail --] [-- Type: text/plain, Size: 3013 bytes --] make all-recursive make[1]: Entering directory '/media/storage/src/guix' Making all in po/guix make[2]: Entering directory '/media/storage/src/guix/po/guix' make[2]: Leaving directory '/media/storage/src/guix/po/guix' Making all in po/packages make[2]: Entering directory '/media/storage/src/guix/po/packages' make[2]: Leaving directory '/media/storage/src/guix/po/packages' make[2]: Entering directory '/media/storage/src/guix' /usr/bin/mkdir -p `dirname "guix/profiles.go"` ; \ LC_ALL=C \ ./pre-inst-env \ /usr/bin/guild compile -L "." -L "." \ -Wformat -Wunbound-variable -Warity-mismatch \ --target="i686-pc-linux-gnu" \ -o "guix/profiles.go" "guix/profiles.scm" ;;; note: source file ./guix/ui.scm ;;; newer than compiled /media/storage/src/guix/guix/ui.go ;;; note: source file ./guix/ui.scm ;;; newer than compiled /home/alexx/.cache/guile/ccache/2.0-LE-4-2.0/media/storage/src/guix/guix/ui.scm.go Backtrace: In ice-9/boot-9.scm: 2951: 19 [define-module* (guix profiles) #:filename ...] 2926: 18 [resolve-imports (((guix ui)) ((guix utils)) ((guix records)) ...)] 2864: 17 [resolve-interface (guix ui) #:select ...] 2789: 16 [#<procedure 83896f0 at ice-9/boot-9.scm:2777:4 (name #:optional autoload version #:key ensure)> # ...] 3065: 15 [try-module-autoload (guix ui) #f] 2401: 14 [save-module-excursion #<procedure 866b780 at ice-9/boot-9.scm:3066:17 ()>] 3085: 13 [#<procedure 866b780 at ice-9/boot-9.scm:3066:17 ()>] In unknown file: ?: 12 [primitive-load-path "guix/ui" ...] In ice-9/eval.scm: 505: 11 [#<procedure 82c1400 at ice-9/eval.scm:499:4 (exp)> (define-module # # ...)] In ice-9/psyntax.scm: 1106: 10 [expand-top-sequence ((define-module (guix ui) #:use-module ...)) () ...] 989: 9 [scan ((define-module (guix ui) #:use-module ...)) () ...] 279: 8 [scan ((#(syntax-object let # ...) (#) (# #) ...)) () ...] In ice-9/eval.scm: 411: 7 [eval # ()] In ice-9/boot-9.scm: 2951: 6 [define-module* (guix ui) #:filename ...] 2926: 5 [resolve-imports (((guix utils)) ((guix store)) ((guix config)) ...)] 2877: 4 [resolve-interface (guix profiles) #:select ...] 768: 3 [for-each #<procedure 842a5a0 at ice-9/boot-9.scm:2877:20 (bspec)> #] 2883: 2 [#<procedure 842a5a0 at ice-9/boot-9.scm:2877:20 (bspec)> profile-not-found-error?] In unknown file: ?: 1 [scm-error misc-error #f ...] In ice-9/boot-9.scm: 106: 0 [#<procedure 84f54e0 at ice-9/boot-9.scm:97:6 (thrown-k . args)> misc-error ...] ice-9/boot-9.scm:106:20: In procedure #<procedure 84f54e0 at ice-9/boot-9.scm:97:6 (thrown-k . args)>: ice-9/boot-9.scm:106:20: no binding `profile-not-found-error?' in module (guix profiles) Makefile:3871: recipe for target 'guix/profiles.go' failed make[2]: *** [guix/profiles.go] Error 1 make[2]: Leaving directory '/media/storage/src/guix' Makefile:3064: recipe for target 'all-recursive' failed make[1]: *** [all-recursive] Error 1 make[1]: Leaving directory '/media/storage/src/guix' Makefile:1803: recipe for target 'all' failed make: *** [all] Error 2 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-09 6:31 ` Alex Kost @ 2014-10-09 21:03 ` Ludovic Courtès 0 siblings, 0 replies; 12+ messages in thread From: Ludovic Courtès @ 2014-10-09 21:03 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel Alex Kost <alezost@gmail.com> skribis: > Ludovic Courtès (2014-10-08 23:55 +0400) wrote: [...] >> However, back to the initial problem, is this a problem if the error >> conditions are defined in (guix profiles), which is then imported by >> (guix ui)? This is suboptimal, but this kind of circular reference >> shouldn’t cause any troubles. > > Do you mean to "#:select" condition types in (guix ui)? No, because #:select basically prevents circular references. > What about making an auxiliary (guix conditions) module with all > existing condition types, and use it where needed? I could try to work > on it if it sounds reasonable. WDYT? Hmm yes, but only as a last resort. I’ve spent some time trying to better understand the problem, but failed (we desperately need tools in Guile do to this sort of things.) Another part of the problem is that (guix monads) uses other modules’ bindings at the top-level. Mark, any ideas? Alex, is there a way we can backtrack a bit and move forward in the meantime? Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-08 19:55 ` Ludovic Courtès 2014-10-09 6:31 ` Alex Kost @ 2014-10-09 22:08 ` Ludovic Courtès 2014-10-10 7:00 ` Alex Kost 1 sibling, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-10-09 22:08 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel ludo@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! Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-09 22:08 ` Ludovic Courtès @ 2014-10-10 7:00 ` Alex Kost 2014-10-10 12:15 ` Ludovic Courtès 0 siblings, 1 reply; 12+ messages in thread From: Alex Kost @ 2014-10-10 7:00 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 2176 bytes --] Ludovic Courtès (2014-10-10 02:08 +0400) wrote: > ludo@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 \f 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). [-- Attachment #2: 0001-profiles-Add-condition-types-for-profiles-and-genera.patch --] [-- Type: text/x-diff, Size: 5757 bytes --] From af9d9869f2430dd3e20885e685867c6843ba4279 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 | 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 @@ \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..feeb10e 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,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 [-- 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: 4739 bytes --] From da49a2b7af5295c3c72b7e4590219cbac827877b 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 | 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 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-10 7:00 ` Alex Kost @ 2014-10-10 12:15 ` Ludovic Courtès 2014-10-10 15:20 ` Alex Kost 0 siblings, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-10-10 12:15 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel 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™. > 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? > 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. :-) > From af9d9869f2430dd3e20885e685867c6843ba4279 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. Perfect! > From da49a2b7af5295c3c72b7e4590219cbac827877b 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. Perfect as well, OK to commit. Thanks, Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-10 12:15 ` Ludovic Courtès @ 2014-10-10 15:20 ` Alex Kost 2014-10-11 21:57 ` Ludovic Courtès 0 siblings, 1 reply; 12+ messages in thread From: Alex Kost @ 2014-10-10 15:20 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- 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 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: ui: Move 'show-manifest-transaction' from (guix profiles). 2014-10-10 15:20 ` Alex Kost @ 2014-10-11 21:57 ` Ludovic Courtès 2014-10-12 5:39 ` [PATCH 2/2] emacs: Add support for switching generations Alex Kost 0 siblings, 1 reply; 12+ messages in thread From: Ludovic Courtès @ 2014-10-11 21:57 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel Alex Kost <alezost@gmail.com> skribis: > 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. Looks good from a quick skim, go ahead! Thanks, Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
* [PATCH 2/2] emacs: Add support for switching generations. 2014-10-11 21:57 ` Ludovic Courtès @ 2014-10-12 5:39 ` Alex Kost 2014-10-12 21:04 ` Ludovic Courtès 0 siblings, 1 reply; 12+ messages in thread From: Alex Kost @ 2014-10-12 5:39 UTC (permalink / raw) To: Ludovic Courtès; +Cc: guix-devel [-- Attachment #1: Type: text/plain, Size: 768 bytes --] Ludovic Courtès (2014-10-12 01:57 +0400) wrote: > Alex Kost <alezost@gmail.com> skribis: > >> 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. > > Looks good from a quick skim, go ahead! Thanks, pushed. Now I would like to add support for switching generations from Emacs UI. The patches for that are attached. Currently there is no way to see what generation is the current one – the first patch will fix it (additional column is added to *Guix Generation List*). [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-emacs-Add-current-generation-parameter.patch --] [-- Type: text/x-diff, Size: 5925 bytes --] From 67089dfee7d212863ad18204bd1ec1b51e0f29db Mon Sep 17 00:00:00 2001 From: Alex Kost <alezost@gmail.com> Date: Fri, 10 Oct 2014 23:50:15 +0400 Subject: [PATCH 1/2] emacs: Add 'current' generation parameter. * emacs/guix-main.scm (generation-param-alist): Add 'current' parameter. * emacs/guix-base.el (guix-param-titles): Add title for 'current' parameter. * emacs/guix-info.el: Display 'current' parameter. (guix-generation-info-current, guix-generation-info-not-current): New faces. (guix-generation-info-insert-current): New procedure. * emacs/guix-list.el: Display 'current' column. (guix-generation-list-get-current): New procedure. --- emacs/guix-base.el | 1 + emacs/guix-info.el | 19 ++++++++++++++++++- emacs/guix-list.el | 11 +++++++++-- emacs/guix-main.scm | 15 ++++++++------- 4 files changed, 36 insertions(+), 10 deletions(-) diff --git a/emacs/guix-base.el b/emacs/guix-base.el index d31fb79..aafa220 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -107,6 +107,7 @@ Interactively, prompt for PATH. With prefix, use (id . "ID") (number . "Number") (prev-number . "Previous number") + (current . "Current") (path . "Path") (time . "Time"))) "List for defining titles of entry parameters. diff --git a/emacs/guix-info.el b/emacs/guix-info.el index d5226b1..fc1b585 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -136,6 +136,7 @@ number of characters, it will be split into several lines.") (location guix-package-info-insert-location)) (generation (number guix-generation-info-insert-number) + (current guix-generation-info-insert-current) (path guix-info-insert-file-path) (time guix-info-insert-time))) "Methods for inserting parameter values. @@ -161,7 +162,7 @@ argument.") (output name version output synopsis path dependencies location home-url license inputs native-inputs propagated-inputs description) (installed path dependencies) - (generation number prev-number time path)) + (generation number prev-number current time path)) "List of displayed entry parameters. Each element of the list should have a form: @@ -613,6 +614,16 @@ ENTRY is an alist with package info." "Face used for a number of a generation." :group 'guix-generation-info) +(defface guix-generation-info-current + '((t :inherit guix-package-info-installed-outputs)) + "Face used if a generation is the current one." + :group 'guix-generation-info) + +(defface guix-generation-info-not-current + '((t nil)) + "Face used if a generation is not the current one." + :group 'guix-generation-info) + (defun guix-generation-info-insert-number (number &optional _) "Insert generation NUMBER and action buttons." (guix-info-insert-val-default number 'guix-generation-info-number) @@ -632,6 +643,12 @@ ENTRY is an alist with package info." "Delete this generation" 'number number)) +(defun guix-generation-info-insert-current (val entry) + "Insert boolean value VAL showing whether this generation is current." + (if val + (guix-info-insert-val-default "Yes" 'guix-generation-info-current) + (guix-info-insert-val-default "No" 'guix-generation-info-not-current))) + (provide 'guix-info) ;;; guix-info.el ends here diff --git a/emacs/guix-list.el b/emacs/guix-list.el index 9cc381b..f9d106b 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -65,6 +65,7 @@ entries, he will be prompted for confirmation." (number 5 ,(lambda (a b) (guix-list-sort-numerically 0 a b)) :right-align t) + (current 10 t) (time 20 t) (path 30 t))) "Columns displayed in list buffers. @@ -93,8 +94,9 @@ this list have a priority.") (synopsis . guix-list-get-one-line) (description . guix-list-get-one-line)) (generation - (time . guix-list-get-time) - (path . guix-list-get-file-path))) + (current . guix-generation-list-get-current) + (time . guix-list-get-time) + (path . guix-list-get-file-path))) "Methods for inserting parameter values in columns. Each element of the list has a form: @@ -735,6 +737,11 @@ Also see `guix-package-info-type'." (define-key map (kbd "i") 'guix-list-describe) (define-key map (kbd "d") 'guix-generation-list-mark-delete)) +(defun guix-generation-list-get-current (val &optional _) + "Return string from VAL showing whether this generation is current. +VAL is a boolean value." + (if val "(current)" "")) + (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index fe599fb..7e26876 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -638,13 +638,14 @@ See 'entry-sexps' for details." (define (generation-param-alist profile) "Return an alist of generation parameters and procedures for PROFILE." - (list - (cons 'id identity) - (cons 'number identity) - (cons 'prev-number (cut previous-generation-number profile <>)) - (cons 'path (cut generation-file-name profile <>)) - (cons 'time (lambda (gen) - (time-second (generation-time profile gen)))))) + (let ((current (generation-number profile))) + `((id . ,identity) + (number . ,identity) + (prev-number . ,(cut previous-generation-number profile <>)) + (current . ,(cut = current <>)) + (path . ,(cut generation-file-name profile <>)) + (time . ,(lambda (gen) + (time-second (generation-time profile gen))))))) (define (matching-generations profile predicate) "Return a list of PROFILE generations matching PREDICATE." -- 2.1.2 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-emacs-Add-support-for-switching-generations.patch --] [-- Type: text/x-diff, Size: 4171 bytes --] From 20d423b27381c562cc87fca4438832208f43f24f Mon Sep 17 00:00:00 2001 From: Alex Kost <alezost@gmail.com> Date: Fri, 10 Oct 2014 23:58:30 +0400 Subject: [PATCH 2/2] emacs: Add support for switching generations. * emacs/guix-base.el (guix-switch-to-generation): New procedure. * emacs/guix-info.el (guix-generation-info-insert-current): Insert button for switching to generation. * emacs/guix-list.el (guix-generation-list-switch): New procedure. * doc/emacs.texi (emacs List buffer, emacs Info buffer): Document switching generations. --- doc/emacs.texi | 3 +++ emacs/guix-base.el | 9 +++++++++ emacs/guix-info.el | 9 ++++++++- emacs/guix-list.el | 11 +++++++++++ 4 files changed, 31 insertions(+), 1 deletion(-) diff --git a/doc/emacs.texi b/doc/emacs.texi index 2e6b60e..01a5712 100644 --- a/doc/emacs.texi +++ b/doc/emacs.texi @@ -205,6 +205,8 @@ List packages installed in the current generation. @item i Describe marked generations (display available information in a ``generation-info'' buffer). +@item s +Switch profile to the current generation. @item d Mark the current generation for deletion (with prefix, mark all generations). @@ -236,6 +238,7 @@ emacs, The Emacs Editor}) which can be used to: @itemize @minus @item remove a generation; +@item switch to a generation; @item list packages installed in a generation; @item jump to a generation directory. @end itemize diff --git a/emacs/guix-base.el b/emacs/guix-base.el index aafa220..5131eb0 100644 --- a/emacs/guix-base.el +++ b/emacs/guix-base.el @@ -816,6 +816,15 @@ Each element from GENERATIONS is a generation number." (guix-make-guile-expression 'delete-generations* guix-current-profile generations)))) +(defun guix-switch-to-generation (generation) + "Switch `guix-current-profile' to GENERATION number." + (when (or (not guix-operation-confirm) + (y-or-n-p (format "Switch current profile to generation %d? " + generation))) + (guix-eval-in-repl + (guix-make-guile-expression + 'switch-to-generation guix-current-profile generation)))) + (provide 'guix-base) ;;; guix-base.el ends here diff --git a/emacs/guix-info.el b/emacs/guix-info.el index fc1b585..7a60090 100644 --- a/emacs/guix-info.el +++ b/emacs/guix-info.el @@ -647,7 +647,14 @@ ENTRY is an alist with package info." "Insert boolean value VAL showing whether this generation is current." (if val (guix-info-insert-val-default "Yes" 'guix-generation-info-current) - (guix-info-insert-val-default "No" 'guix-generation-info-not-current))) + (guix-info-insert-val-default "No" 'guix-generation-info-not-current) + (guix-info-insert-indent) + (guix-info-insert-action-button + "Switch" + (lambda (btn) + (guix-switch-to-generation (button-get btn 'number))) + "Switch to this generation (make it the current one)" + 'number (guix-get-key-val entry 'number)))) (provide 'guix-info) diff --git a/emacs/guix-list.el b/emacs/guix-list.el index f9d106b..c3e8ef4 100644 --- a/emacs/guix-list.el +++ b/emacs/guix-list.el @@ -735,6 +735,7 @@ Also see `guix-package-info-type'." (define-key map (kbd "RET") 'guix-generation-list-show-packages) (define-key map (kbd "x") 'guix-generation-list-execute) (define-key map (kbd "i") 'guix-list-describe) + (define-key map (kbd "s") 'guix-generation-list-switch) (define-key map (kbd "d") 'guix-generation-list-mark-delete)) (defun guix-generation-list-get-current (val &optional _) @@ -742,6 +743,16 @@ Also see `guix-package-info-type'." VAL is a boolean value." (if val "(current)" "")) +(defun guix-generation-list-switch () + "Switch current profile to the generation at point." + (interactive) + (let* ((entry (guix-list-current-entry)) + (current (guix-get-key-val entry 'current)) + (number (guix-get-key-val entry 'number))) + (if current + (user-error "This generation is already the current one") + (guix-switch-to-generation number)))) + (defun guix-generation-list-show-packages () "List installed packages for the generation at point." (interactive) -- 2.1.2 ^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH 2/2] emacs: Add support for switching generations. 2014-10-12 5:39 ` [PATCH 2/2] emacs: Add support for switching generations Alex Kost @ 2014-10-12 21:04 ` Ludovic Courtès 0 siblings, 0 replies; 12+ messages in thread From: Ludovic Courtès @ 2014-10-12 21:04 UTC (permalink / raw) To: Alex Kost; +Cc: guix-devel Alex Kost <alezost@gmail.com> skribis: > Thanks, pushed. Now I would like to add support for switching > generations from Emacs UI. The patches for that are attached. > > Currently there is no way to see what generation is the current one – > the first patch will fix it (additional column is added to *Guix > Generation List*). OK, this looks good to me. Thanks! Ludo’. ^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2014-10-12 21:04 UTC | newest] Thread overview: 12+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2014-10-08 14:19 ui: Move 'show-manifest-transaction' from (guix profiles) Alex Kost 2014-10-08 17:57 ` Alex Kost 2014-10-08 19:55 ` Ludovic Courtès 2014-10-09 6:31 ` Alex Kost 2014-10-09 21:03 ` Ludovic Courtès 2014-10-09 22:08 ` Ludovic Courtès 2014-10-10 7:00 ` Alex Kost 2014-10-10 12:15 ` Ludovic Courtès 2014-10-10 15:20 ` Alex Kost 2014-10-11 21:57 ` Ludovic Courtès 2014-10-12 5:39 ` [PATCH 2/2] emacs: Add support for switching generations Alex Kost 2014-10-12 21:04 ` Ludovic Courtès
Code repositories for project(s) associated with this external index https://git.savannah.gnu.org/cgit/guix.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.