Re: [PATCH] Emacs interface for Guix

[Alex Kost <alezost@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1706 bytes --]

Ludovic Courtès (2014-08-16 16:24 +0400) wrote:

> (Sorry for replying to messages in the wrong order.  :-))

Sorry, I had sent old patches before you sent this message :)  Ignore
my previous message (with the subject "[PATCH] manifest-transaction")
please.

> Alex Kost <alezost@gmail.com> skribis:
>
>> Ok, I'm attaching these patches.  But there are several issues there:
>>
>> - I fixed a typo in "tests/profiles.scm" (“profile” -> “profiles”) – Is
>>   it ok to do this in that commit or should there be a separate commit?
>
> No that’s OK.
>
>> - I added a copyright line to the test file as well.  Is it ok?
>
> Sure!
>
>> - The main thing: look at ‘manifest-show-transaction’ – unlike
>>   ‘show-what-to-remove/install’ it doesn't display an output path of a
>>   package item, because a store should be used for that.  So is it
>>   acceptable or should something be changed there?
>
> I think it should be changed to display the same thing as before.  What
> about adding just a ‘store’ parameter to ‘manifest-show-transaction’,
> and then just use the same code as ‘show-what-to-remove/install’?
>
> Other than that the two patches look good, so if you make that change,
> we can go ahead.

I've made the change (the ‘store’ argument is added now).  The patches
are attached.

>>>> Also I think "guix.el" should check for freshness too, so
>>>> ‘check-package-freshness’ should probably be exported.
>>>
>>> Yes, probably in the (gnu packages) module?
>>
>> Probably, but I think I'm not competent to decide :)
>
> Well, take it as a suggestion then.  :-)

OK, I'll send a patch for that later.  Thanks.


[-- Attachment #2: 0001-profiles-Add-manifest-transaction.patch --]
[-- Type: text/x-patch, Size: 6631 bytes --]

From 7641752189cfc4ad3c85a042ea9eeea2b39435b4 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
Date: Thu, 14 Aug 2014 00:03:53 +0400
Subject: [PATCH 1/2] profiles: Add 'manifest-transaction'.

* guix/profiles.scm (<manifest-transaction>): 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..2398b89 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -18,6 +19,7 @@
 ;;; 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)
@@ -51,6 +53,13 @@
             manifest-installed?
             manifest-matching-entries
 
+            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 output as ENTRIES."
 
 \f
 ;;;
+;;; Manifest transactions.
+;;;
+
+(define-record-type* <manifest-transaction> manifest-transaction
+  make-manifest-transaction
+  manifest-transaction?
+  (install manifest-transaction-install ; list of <manifest-entry>
+           (default '()))
+  (remove  manifest-transaction-remove  ; list of <manifest-pattern>
+           (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 store
+                                    #:key dry-run?)
+  "Display what will/would be installed/removed from MANIFEST by TRANSACTION."
+  ;; TODO: Report upgrades more clearly.
+  (let ((install (manifest-transaction-install transaction))
+        (remove  (manifest-matching-entries
+                  manifest (manifest-transaction-remove transaction))))
+    (match remove
+      ((($ <manifest-entry> 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
+      ((($ <manifest-entry> 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))))
+
+\f
+;;;
 ;;; Profiles.
 ;;;
 
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 © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014 Alex Kost <alezost@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,7 +27,7 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-64))
 
-;; Test the (guix profile) module.
+;; Test the (guix profiles) module.
 
 (define %store
   (open-connection))
@@ -122,6 +123,25 @@
            (_ #f))
          (equal? m3 m4))))
 
+(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)
+           ((($ <manifest-entry> "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
-- 
2.0.3


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-guix-package-Use-manifest-transaction.patch --]
[-- Type: text/x-patch, Size: 4748 bytes --]

From 9bc3426a4550fe7e28a4c9ff807e3650f0ab1b92 Mon Sep 17 00:00:00 2001
From: Alex Kost <alezost@gmail.com>
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..e17ae18 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
-    ((($ <manifest-entry> 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
-    ((($ <manifest-entry> 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)))
-
 \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 (%store)
+                                            #:dry-run? dry-run?)
                  (show-what-to-build (%store) (list prof-drv)
                                      #:use-substitutes?
                                      (assoc-ref opts 'substitutes?)
-- 
2.0.3


[-- Attachment #4: Type: text/plain, Size: 9 bytes --]


--
Alex