aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/profiles.scm49
-rw-r--r--tests/profiles.scm19
2 files changed, 52 insertions, 16 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 55c3b6e768..843040156c 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -32,6 +32,7 @@
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
#:export (manifest make-manifest
@@ -60,6 +61,7 @@
manifest-transaction-install
manifest-transaction-remove
manifest-perform-transaction
+ manifest-transaction-effects
manifest-show-transaction
profile-manifest
@@ -266,6 +268,35 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
(remove manifest-transaction-remove ; list of <manifest-pattern>
(default '())))
+(define (manifest-transaction-effects manifest transaction)
+ "Compute the effect of applying TRANSACTION to MANIFEST. Return 3 values:
+the list of packages that would be removed, installed, or upgraded when
+applying TRANSACTION to MANIFEST."
+ (define (manifest-entry->pattern entry)
+ (manifest-pattern
+ (name (manifest-entry-name entry))
+ (output (manifest-entry-output entry))))
+
+ (let loop ((input (manifest-transaction-install transaction))
+ (install '())
+ (upgrade '()))
+ (match input
+ (()
+ (let ((remove (manifest-transaction-remove transaction)))
+ (values (manifest-matching-entries manifest remove)
+ (reverse install) (reverse upgrade))))
+ ((entry rest ...)
+ ;; Check whether installing ENTRY corresponds to the installation of a
+ ;; new package or to an upgrade.
+
+ ;; XXX: When the exact same output directory is installed, we're not
+ ;; really upgrading anything. Add a check for that case.
+ (let* ((pattern (manifest-entry->pattern entry))
+ (upgrade? (manifest-installed? manifest pattern)))
+ (loop rest
+ (if upgrade? install (cons entry install))
+ (if upgrade? (cons entry upgrade) upgrade)))))))
+
(define (manifest-perform-transaction manifest transaction)
"Perform TRANSACTION on MANIFEST and return new manifest."
(let ((install (manifest-transaction-install transaction))
@@ -284,22 +315,8 @@ Remove MANIFEST entries that have the same name and output as ENTRIES."
item)))
name version output item))
- (let* ((remove (manifest-matching-entries
- manifest (manifest-transaction-remove transaction)))
- (install/upgrade (manifest-transaction-install transaction))
- (install '())
- (upgrade (append-map
- (lambda (entry)
- (let ((matching
- (manifest-matching-entries
- manifest
- (list (manifest-pattern
- (name (manifest-entry-name entry))
- (output (manifest-entry-output entry)))))))
- (when (null? matching)
- (set! install (cons entry install)))
- matching))
- install/upgrade)))
+ (let-values (((remove install upgrade)
+ (manifest-transaction-effects manifest transaction)))
(match remove
((($ <manifest-entry> name version output item _) ..1)
(let ((len (length name))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 047c5ba49b..d88def32fd 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -26,6 +26,7 @@
#:use-module (guix derivations)
#:use-module (gnu packages bootstrap)
#:use-module (ice-9 match)
+ #:use-module (srfi srfi-11)
#:use-module (srfi srfi-64))
;; Test the (guix profiles) module.
@@ -53,6 +54,13 @@
(manifest-entry (inherit guile-2.0.9)
(output "debug")))
+(define glibc
+ (manifest-entry
+ (name "glibc")
+ (version "2.19")
+ (item "/gnu/store/...")
+ (output "out")))
+
(test-begin "profiles")
@@ -136,6 +144,17 @@
(equal? m1 m2)
(null? (manifest-entries m3)))))
+(test-assert "manifest-transaction-effects"
+ (let* ((m0 (manifest (list guile-1.8.8)))
+ (t (manifest-transaction
+ (install (list guile-2.0.9 glibc))
+ (remove (list (manifest-pattern (name "coreutils")))))))
+ (let-values (((remove install upgrade)
+ (manifest-transaction-effects m0 t)))
+ (and (null? remove)
+ (equal? (list glibc) install)
+ (equal? (list guile-2.0.9) upgrade)))))
+
(test-assert "profile-derivation"
(run-with-store %store
(mlet* %store-monad