diff options
| -rw-r--r-- | guix/profiles.scm | 27 | ||||
| -rw-r--r-- | tests/profiles.scm | 3 |
2 files changed, 29 insertions, 1 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index cd448e3f253..ac2fa051b28 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm | |||
| @@ -78,6 +78,9 @@ | |||
| 78 | manifest-transaction? | 78 | manifest-transaction? |
| 79 | manifest-transaction-install | 79 | manifest-transaction-install |
| 80 | manifest-transaction-remove | 80 | manifest-transaction-remove |
| 81 | manifest-transaction-install-entry | ||
| 82 | manifest-transaction-remove-pattern | ||
| 83 | manifest-transaction-null? | ||
| 81 | manifest-perform-transaction | 84 | manifest-perform-transaction |
| 82 | manifest-transaction-effects | 85 | manifest-transaction-effects |
| 83 | 86 | ||
| @@ -383,6 +386,28 @@ no match.." | |||
| 383 | (remove manifest-transaction-remove ; list of <manifest-pattern> | 386 | (remove manifest-transaction-remove ; list of <manifest-pattern> |
| 384 | (default '()))) | 387 | (default '()))) |
| 385 | 388 | ||
| 389 | (define (manifest-transaction-install-entry entry transaction) | ||
| 390 | "Augment TRANSACTION's set of installed packages with ENTRY, a | ||
| 391 | <manifest-entry>." | ||
| 392 | (manifest-transaction | ||
| 393 | (inherit transaction) | ||
| 394 | (install | ||
| 395 | (cons entry (manifest-transaction-install transaction))))) | ||
| 396 | |||
| 397 | (define (manifest-transaction-remove-pattern pattern transaction) | ||
| 398 | "Add PATTERN to TRANSACTION's list of packages to remove." | ||
| 399 | (manifest-transaction | ||
| 400 | (inherit transaction) | ||
| 401 | (remove | ||
| 402 | (cons pattern (manifest-transaction-remove transaction))))) | ||
| 403 | |||
| 404 | (define (manifest-transaction-null? transaction) | ||
| 405 | "Return true if TRANSACTION has no effect---i.e., it neither installs nor | ||
| 406 | remove software." | ||
| 407 | (match transaction | ||
| 408 | (($ <manifest-transaction> () ()) #t) | ||
| 409 | (($ <manifest-transaction> _ _) #f))) | ||
| 410 | |||
| 386 | (define (manifest-transaction-effects manifest transaction) | 411 | (define (manifest-transaction-effects manifest transaction) |
| 387 | "Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values: | 412 | "Compute the effect of applying TRANSACTION to MANIFEST. Return 4 values: |
| 388 | the list of packages that would be removed, installed, upgraded, or downgraded | 413 | the list of packages that would be removed, installed, upgraded, or downgraded |
| @@ -424,7 +449,7 @@ replace it." | |||
| 424 | downgrade))))))) | 449 | downgrade))))))) |
| 425 | 450 | ||
| 426 | (define (manifest-perform-transaction manifest transaction) | 451 | (define (manifest-perform-transaction manifest transaction) |
| 427 | "Perform TRANSACTION on MANIFEST and return new manifest." | 452 | "Perform TRANSACTION on MANIFEST and return the new manifest." |
| 428 | (let ((install (manifest-transaction-install transaction)) | 453 | (let ((install (manifest-transaction-install transaction)) |
| 429 | (remove (manifest-transaction-remove transaction))) | 454 | (remove (manifest-transaction-remove transaction))) |
| 430 | (manifest-add (manifest-remove manifest remove) | 455 | (manifest-add (manifest-remove manifest remove) |
diff --git a/tests/profiles.scm b/tests/profiles.scm index 028d7b6fb45..f9c2f5499ee 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm | |||
| @@ -187,6 +187,9 @@ | |||
| 187 | (and (null? remove) (null? install) (null? downgrade) | 187 | (and (null? remove) (null? install) (null? downgrade) |
| 188 | (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade))))) | 188 | (equal? (list (cons guile-2.0.9 guile-2.0.9)) upgrade))))) |
| 189 | 189 | ||
| 190 | (test-assert "manifest-transaction-null?" | ||
| 191 | (manifest-transaction-null? (manifest-transaction))) | ||
| 192 | |||
| 190 | (test-assertm "profile-derivation" | 193 | (test-assertm "profile-derivation" |
| 191 | (mlet* %store-monad | 194 | (mlet* %store-monad |
| 192 | ((entry -> (package->manifest-entry %bootstrap-guile)) | 195 | ((entry -> (package->manifest-entry %bootstrap-guile)) |
