mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 05:18:07 -05:00
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.
This commit is contained in:
parent
dd72173455
commit
c8c25704ae
2 changed files with 29 additions and 1 deletions
|
@ -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> manifest-transaction
|
|||
(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 @@ (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)
|
||||
|
|
|
@ -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))
|
||||
|
|
Loading…
Reference in a new issue