From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: Re: ui: Move 'show-manifest-transaction' from (guix profiles). Date: Wed, 08 Oct 2014 21:57:43 +0400 Message-ID: <87a956igvc.fsf@gmail.com> References: <87eguiiqzt.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:59171) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XbvUl-0002qH-Hq for guix-devel@gnu.org; Wed, 08 Oct 2014 13:57:57 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XbvUg-0003BH-0X for guix-devel@gnu.org; Wed, 08 Oct 2014 13:57:51 -0400 In-Reply-To: <87eguiiqzt.fsf@gmail.com> (Alex Kost's message of "Wed, 08 Oct 2014 18:19:02 +0400") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: guix-devel@gnu.org --=-=-= Content-Type: text/plain 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. --=-=-= Content-Type: text/x-diff; charset=utf-8 Content-Disposition: attachment; filename=0001-ui-Move-show-manifest-transaction-from-guix-profiles.patch Content-Transfer-Encoding: quoted-printable >From 480c22f37437ce138d4fe822f5b1c15f1f65be0e Mon Sep 17 00:00:00 2001 From: Alex Kost 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 l= ist)." (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 . =20 (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 =20 profile-manifest package->manifest-entry @@ -315,97 +313,6 @@ it." (manifest-add (manifest-remove manifest remove) install))) =20 -(define (right-arrow port) - "Return either a string containing the 'RIGHT ARROW' character, or an AS= CII -replacement if PORT is not Unicode-capable." - (with-fluids ((%default-port-encoding (port-encoding port))) - (let ((arrow "=E2=86=92")) - (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 TRANSACTI= ON." - (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 =E2=86=92 ;an arrow that can be represent= ed 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 =E2=86=92 new-version - (if (package? item) - (package-output store item output) - item))) - - (let-values (((remove install upgrade) - (manifest-transaction-effects manifest transaction))) - (match remove - ((($ 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 - (((($ name old-version) - . ($ _ 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 - ((($ 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)))) - ;;; ;;; 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))) =20 +(define (right-arrow port) + "Return either a string containing the 'RIGHT ARROW' character, or an AS= CII +replacement if PORT is not Unicode-capable." + (with-fluids ((%default-port-encoding (port-encoding port))) + (let ((arrow "=E2=86=92")) + (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 TRANSACTI= ON." + (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 =E2=86=92 ;an arrow that can be represent= ed 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 =E2=86=92 new-version + (if (package? item) + (package-output store item output) + item))) + + (let-values (((remove install upgrade) + (manifest-transaction-effects manifest transaction))) + (match remove + ((($ 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 + (((($ name old-version) + . ($ _ 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 + ((($ 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))))) =20 -(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 =E2=86=92 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 @@ =20 (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 POS= IX system calls, networking support, multiple threads, dynamic linking, a foreign function = call interface, and powerful string processing.") =20 +(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"))) + (test-begin "ui") =20 @@ -210,6 +225,23 @@ Second line" 24)) ;; This should print nothing. (show-what-to-build store (list drv))))))) =20 +(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 =E2=86=92 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") =20 --=20 2.1.2 --=-=-=--