From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: [PATCH] manifest-transaction Date: Sat, 16 Aug 2014 14:52:51 +0400 Message-ID: <874mxcemf0.fsf_-_@gmail.com> References: <87k3719v7p.fsf@gmail.com> <87r419fa50.fsf@gnu.org> <87fvho9fqm.fsf@gmail.com> <87a97taixl.fsf@gmail.com> <87sil2rbly.fsf@gnu.org> <87tx5idn7f.fsf_-_@gmail.com> <87egwlkcy1.fsf@gnu.org> <87ppg5el2i.fsf@gmail.com> <87d2c5h4if.fsf@gnu.org> <87lhqsev1d.fsf@gmail.com> <877g2c74xh.fsf@gnu.org> <87ha1gds3w.fsf@gmail.com> <878umqe1wm.fsf@gmail.com> <87egwgokco.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:58768) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XIbbT-000328-7r for guix-devel@gnu.org; Sat, 16 Aug 2014 06:52:59 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XIbbO-0008KV-KA for guix-devel@gnu.org; Sat, 16 Aug 2014 06:52:55 -0400 In-Reply-To: <87egwgokco.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Sat, 16 Aug 2014 11:27:19 +0200") 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; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s (2014-08-16 13:27 +0400) wrote: [...] > Computed strings like impede correct internationalization. The whole > sentences must be kept intact, to make sure people can translate them > correctly. So that means repeating things a bit, but that=E2=80=99s > unavoidable. Ah, indeed, I didn't think about internationalization. >> I tried to avoid the code duplicating, so it became more compact and >> perhaps less readable. Also I added reporting about the packages to >> upgrade: I thought as they are going to be replaced by the packages to >> install, it is ok to add =E2=80=9C(removed)=E2=80=9D there. So an outpu= t should look >> like this (assuming "file-5.17" and "guile-2.0.9" are installed and are >> being upgraded): >> >> The following packages will be upgraded (removed): >> file-5.17 out /gnu/store/... >> guile-2.0.9 out /gnu/store/... >> >> The following packages will be installed: >> file-5.18 out >> guile-2.0.11 out > > Ideally, I would just like to see: > > The following packages will be upgraded: > file-5.17 out /gnu/store/... > guile-2.0.9 out /gnu/store/... > > and not see them listed under =E2=80=9Cwill be installed.=E2=80=9D As you wish (although I would prefer to see what is upgraded and what is installed in that manner). > I would just keep the current messages for this patch series, and come > up with an improved message format in a separate patch. > > WDYT? No problem, so here are the patches again (the second one is modified: I forgot to delete one unused line last time). And just in case I'm mentioning an issue with =E2=80=98manifest-show-transaction=E2=80=99 again:= unlike =E2=80=98show-what-to-remove/install=E2=80=99, it doesn't display an output= path of a package item, because a store should be used for that. So should something be done with it? --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-profiles-Add-manifest-transaction.patch Content-Transfer-Encoding: quoted-printable >From d2d3f9d296c26ad1d4a1e17d56ae3e3361ca02d7 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 14 Aug 2014 00:03:53 +0400 Subject: [PATCH 1/2] profiles: Add 'manifest-transaction'. * guix/profiles.scm (): New record-type. (manifest-perform-transaction): New procedure. (manifest-show-transaction): New procedure. * tests/profiles.scm ("manifest-perform-transaction"): New test. --- guix/profiles.scm | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++= ++++ tests/profiles.scm | 22 +++++++++++++++- 2 files changed, 96 insertions(+), 1 deletion(-) diff --git a/guix/profiles.scm b/guix/profiles.scm index e921566..55a3348 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013, 2014 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2013 Nikita Karetnikov +;;; Copyright =C2=A9 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -18,6 +19,7 @@ ;;; 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) @@ -51,6 +53,13 @@ manifest-installed? manifest-matching-entries =20 + manifest-transaction + manifest-transaction? + manifest-transaction-install + manifest-transaction-remove + manifest-perform-transaction + manifest-show-transaction + profile-manifest package->manifest-entry profile-derivation @@ -244,6 +253,72 @@ Remove MANIFEST entries that have the same name and ou= tput as ENTRIES." =20 ;;; +;;; Manifest transactions. +;;; + +(define-record-type* manifest-transaction + make-manifest-transaction + manifest-transaction? + (install manifest-transaction-install ; list of + (default '())) + (remove manifest-transaction-remove ; list of + (default '()))) + +(define (manifest-perform-transaction manifest transaction) + "Perform TRANSACTION on MANIFEST and return new manifest." + (let ((install (manifest-transaction-install transaction)) + (remove (manifest-transaction-remove transaction))) + (manifest-add (manifest-remove manifest remove) + install))) + +(define* (manifest-show-transaction manifest transaction #:key dry-run?) + "Display what will/would be installed/removed from MANIFEST by TRANSACTI= ON." + ;; TODO: Report upgrades more clearly. + (let ((install (manifest-transaction-install transaction)) + (remove (manifest-matching-entries + manifest (manifest-transaction-remove transaction)))) + (match remove + ((($ name version output path _) ..1) + (let ((len (length name)) + (remove (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>) + name version output path))) + (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 install + ((($ name version output item _) ..1) + (let ((len (length name)) + (install (map (lambda (name version output item) + (if (package? item) + (format #f " ~a-~a\t~a" + name version output) + (format #f " ~a-~a\t~a\t~a" + name version output item))) + 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. ;;; =20 diff --git a/tests/profiles.scm b/tests/profiles.scm index b2919d7..e1f1eef 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright =C2=A9 2013, 2014 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2014 Alex Kost ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,7 +27,7 @@ #:use-module (ice-9 match) #:use-module (srfi srfi-64)) =20 -;; Test the (guix profile) module. +;; Test the (guix profiles) module. =20 (define %store (open-connection)) @@ -122,6 +123,25 @@ (_ #f)) (equal? m3 m4)))) =20 +(test-assert "manifest-perform-transaction" + (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug))) + (t1 (manifest-transaction + (install (list guile-1.8.8)) + (remove (list (manifest-pattern (name "guile") + (output "debug")))))) + (t2 (manifest-transaction + (remove (list (manifest-pattern (name "guile") + (version "2.0.9") + (output #f)))))) + (m1 (manifest-perform-transaction m0 t1)) + (m2 (manifest-perform-transaction m1 t2)) + (m3 (manifest-perform-transaction m0 t2))) + (and (match (manifest-entries m1) + ((($ "guile" "1.8.8" "out")) #t) + (_ #f)) + (equal? m1 m2) + (null? (manifest-entries m3))))) + (test-assert "profile-derivation" (run-with-store %store (mlet* %store-monad --=20 2.0.3 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-guix-package-Use-manifest-transaction.patch >From 65511b43843742f2e9bea9bfd611418cf399e524 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 14 Aug 2014 00:15:48 +0400 Subject: [PATCH 2/2] guix package: Use 'manifest-transaction'. * guix/scripts/package.scm (guix-package)[process-actions]: Use 'manifest-transaction' instead of the equivalent code. (show-what-to-remove/install): Remove. --- guix/scripts/package.scm | 63 +++++++++--------------------------------------- 1 file changed, 11 insertions(+), 52 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 3bfef4f..6f920d3 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -184,49 +184,6 @@ DURATION-RELATION with the current time." filter-by-duration) (else #f))) -(define (show-what-to-remove/install remove install dry-run?) - "Given the manifest entries listed in REMOVE and INSTALL, display the -packages that will/would be installed and removed." - ;; TODO: Report upgrades more clearly. - (match remove - ((($ name version output path _) ..1) - (let ((len (length name)) - (remove (map (cut format #f " ~a-~a\t~a\t~a" <> <> <> <>) - name version output path))) - (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 install - ((($ name version output item _) ..1) - (let ((len (length name)) - (install (map (lambda (name version output item) - (format #f " ~a-~a\t~a\t~a" name version output - (if (package? item) - (package-output (%store) item output) - item))) - 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))) - ;;; ;;; Package specifications. @@ -863,21 +820,23 @@ more information.~%")) (_ #f)) opts)) (else - (let* ((manifest (profile-manifest profile)) - (install (options->installable opts manifest)) - (remove (options->removable opts manifest)) - (new (manifest-add (manifest-remove manifest remove) - install))) + (let* ((manifest (profile-manifest profile)) + (install (options->installable opts manifest)) + (remove (options->removable opts manifest)) + (transaction (manifest-transaction (install install) + (remove remove))) + (new (manifest-perform-transaction + manifest transaction))) (when (equal? profile %current-profile) (ensure-default-profile)) (unless (and (null? install) (null? remove)) (let* ((prof-drv (run-with-store (%store) - (profile-derivation new))) - (prof (derivation->output-path prof-drv)) - (remove (manifest-matching-entries manifest remove))) - (show-what-to-remove/install remove install dry-run?) + (profile-derivation new))) + (prof (derivation->output-path prof-drv))) + (manifest-show-transaction manifest transaction + #:dry-run? dry-run?) (show-what-to-build (%store) (list prof-drv) #:use-substitutes? (assoc-ref opts 'substitutes?) -- 2.0.3 --=-=-=--