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.master
parent
dd72173455
commit
c8c25704ae
|
@ -78,6 +78,9 @@
|
||||||
manifest-transaction?
|
manifest-transaction?
|
||||||
manifest-transaction-install
|
manifest-transaction-install
|
||||||
manifest-transaction-remove
|
manifest-transaction-remove
|
||||||
|
manifest-transaction-install-entry
|
||||||
|
manifest-transaction-remove-pattern
|
||||||
|
manifest-transaction-null?
|
||||||
manifest-perform-transaction
|
manifest-perform-transaction
|
||||||
manifest-transaction-effects
|
manifest-transaction-effects
|
||||||
|
|
||||||
|
@ -383,6 +386,28 @@ no match.."
|
||||||
(remove manifest-transaction-remove ; list of <manifest-pattern>
|
(remove manifest-transaction-remove ; list of <manifest-pattern>
|
||||||
(default '())))
|
(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)
|
(define (manifest-transaction-effects manifest transaction)
|
||||||
"Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values:
|
"Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values:
|
||||||
the list of packages that would be removed, installed, upgraded, or downgraded
|
the list of packages that would be removed, installed, upgraded, or downgraded
|
||||||
|
@ -424,7 +449,7 @@ replace it."
|
||||||
downgrade)))))))
|
downgrade)))))))
|
||||||
|
|
||||||
(define (manifest-perform-transaction manifest transaction)
|
(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))
|
(let ((install (manifest-transaction-install transaction))
|
||||||
(remove (manifest-transaction-remove transaction)))
|
(remove (manifest-transaction-remove transaction)))
|
||||||
(manifest-add (manifest-remove manifest remove)
|
(manifest-add (manifest-remove manifest remove)
|
||||||
|
|
|
@ -187,6 +187,9 @@
|
||||||
(and (null? remove) (null? install) (null? downgrade)
|
(and (null? remove) (null? install) (null? downgrade)
|
||||||
(equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade)))))
|
(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"
|
(test-assertm "profile-derivation"
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
((entry -> (package->manifest-entry %bootstrap-guile))
|
((entry -> (package->manifest-entry %bootstrap-guile))
|
||||||
|
|
Loading…
Reference in New Issue