From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: Re: [PATCH] Emacs interface for Guix Date: Thu, 14 Aug 2014 00:58:27 +0400 Message-ID: <87ha1gds3w.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> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:51656) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1XHfcx-0005TO-3s for guix-devel@gnu.org; Wed, 13 Aug 2014 16:58:39 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1XHfcs-0003z8-EK for guix-devel@gnu.org; Wed, 13 Aug 2014 16:58:35 -0400 In-Reply-To: <877g2c74xh.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Wed, 13 Aug 2014 18:03:22 +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-13 20:03 +0400) wrote: > Alex Kost skribis: > > [...] > >> (I excluded =E2=80=9Cupgrade=E2=80=9D part as it's the same as =E2=80=9C= install=E2=80=9D, and >> =E2=80=98show-transaction=E2=80=99 is almost the same as =E2=80=98show-w= hat-to-remove/install=E2=80=99 >> from "package.scm".) > > Yes. > > Could you turn the above thing into a patch with a commit log? Bonus > points for =E2=80=98manifest-perform-transaction=E2=80=99 unit tests. Ma= ke sure to add > a copyright line for yourself in profiles.scm. > > And then a second patch to actually use it in (guix scripts package) > would be wonderful. :-) Ok, I'm attaching these patches. But there are several issues there: - I fixed a typo in "tests/profiles.scm" (=E2=80=9Cprofile=E2=80=9D -> =E2= =80=9Cprofiles=E2=80=9D) =E2=80=93 Is it ok to do this in that commit or should there be a separate commit? - I added a copyright line to the test file as well. Is it ok? - The main thing: look at =E2=80=98manifest-show-transaction=E2=80=99 =E2= =80=93 unlike =E2=80=98show-what-to-remove/install=E2=80=99 it doesn't display an outpu= t path of a package item, because a store should be used for that. So is it acceptable or should something be changed there? > In the next iteration, =E2=80=98show-what-to-remove/install=E2=80=99 shou= ld report > packages that are going to be upgraded (by checking among =E2=80=98instal= l=E2=80=99 > those are already in the manifest.) I'll try to do this. >> Also I think "guix.el" should check for freshness too, so >> =E2=80=98check-package-freshness=E2=80=99 should probably be exported. > > Yes, probably in the (gnu packages) module? Probably, but I think I'm not competent to decide :) --=-=-= 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 5358263f259ea099bbcb62a6bc548c6c9fdb1567 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 | 60 ++++++++---------------------------------------- 1 file changed, 10 insertions(+), 50 deletions(-) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 3bfef4f..b7bdadc 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,24 @@ 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))) + (profile-derivation new))) (prof (derivation->output-path prof-drv)) (remove (manifest-matching-entries manifest remove))) - (show-what-to-remove/install remove install dry-run?) + (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 --=-=-= Content-Type: text/plain -- Alex Kost --=-=-=--