diff --git a/guix/profiles.scm b/guix/profiles.scm index cd448e3f25..ac2fa051b2 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -78,6 +78,9 @@ (define-module (guix profiles) 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 @@ (define-record-type* manifest-transaction (remove manifest-transaction-remove ; list of (default '()))) +(define (manifest-transaction-install-entry entry transaction) + "Augment TRANSACTION's set of installed packages with ENTRY, a +." + (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 + (($ () ()) #t) + (($ _ _) #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 @@ (define (manifest-entry->pattern entry) 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 028d7b6fb4..f9c2f5499e 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -187,6 +187,9 @@ (define glibc (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))