02/06: profiles: Add manifest-transaction helper procedures.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit c8c25704aeb2e5fa4feb6a86235f9565738eea99
Author: Ludovic Courtès <address@hidden>
Date:   Tue Sep 6 20:19:21 2016 +0200

    profiles: Add manifest-transaction helper procedures.
    
    * guix/profiles.scm (manifest-transaction-install-entry)
    (manifest-transaction-remove-pattern)
    (manifest-transaction-null?): New procedures.
    * tests/profiles.scm ("manifest-transaction-null?"): New test.
---
 guix/profiles.scm  |   27 ++++++++++++++++++++++++++-
 tests/profiles.scm |    3 +++
 2 files changed, 29 insertions(+), 1 deletion(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index cd448e3..ac2fa05 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -78,6 +78,9 @@
             manifest-transaction?
             manifest-transaction-install
             manifest-transaction-remove
+            manifest-transaction-install-entry
+            manifest-transaction-remove-pattern
+            manifest-transaction-null?
             manifest-perform-transaction
             manifest-transaction-effects
 
@@ -383,6 +386,28 @@ no match.."
   (remove  manifest-transaction-remove  ; list of <manifest-pattern>
            (default '())))
 
+(define (manifest-transaction-install-entry entry transaction)
+  "Augment TRANSACTION's set of installed packages with ENTRY, a
+<manifest-entry>."
+  (manifest-transaction
+   (inherit transaction)
+   (install
+    (cons entry (manifest-transaction-install transaction)))))
+
+(define (manifest-transaction-remove-pattern pattern transaction)
+  "Add PATTERN to TRANSACTION's list of packages to remove."
+  (manifest-transaction
+   (inherit transaction)
+   (remove
+    (cons pattern (manifest-transaction-remove transaction)))))
+
+(define (manifest-transaction-null? transaction)
+  "Return true if TRANSACTION has no effect---i.e., it neither installs nor
+remove software."
+  (match transaction
+    (($ <manifest-transaction> () ()) #t)
+    (($ <manifest-transaction> _ _)   #f)))
+
 (define (manifest-transaction-effects manifest transaction)
   "Compute the effect of applying TRANSACTION to MANIFEST.  Return 4 values:
 the list of packages that would be removed, installed, upgraded, or downgraded
@@ -424,7 +449,7 @@ replace it."
                    downgrade)))))))
 
 (define (manifest-perform-transaction manifest transaction)
-  "Perform TRANSACTION on MANIFEST and return new manifest."
+  "Perform TRANSACTION on MANIFEST and return the new manifest."
   (let ((install (manifest-transaction-install transaction))
         (remove  (manifest-transaction-remove transaction)))
     (manifest-add (manifest-remove manifest remove)
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 028d7b6..f9c2f54 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -187,6 +187,9 @@
       (and (null? remove) (null? install) (null? downgrade)
            (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
 
+(test-assert "manifest-transaction-null?"
+  (manifest-transaction-null? (manifest-transaction)))
+
 (test-assertm "profile-derivation"
   (mlet* %store-monad
       ((entry ->   (package->manifest-entry %bootstrap-guile))