aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlex Kost <alezost@gmail.com>2014-08-12 12:32:16 +0400
committerLudovic Courtès <ludo@gnu.org>2014-08-12 16:03:33 +0200
commitf755403014e70d875541bcce5474d2cf410b5da1 (patch)
tree635b9324e483daa472ed04eb943fd00422444837
parent599f146400ea687dfda590babc9992ca8f86a482 (diff)
downloadpatches-f755403014e70d875541bcce5474d2cf410b5da1.tar
patches-f755403014e70d875541bcce5474d2cf410b5da1.tar.gz
profiles: Add 'manifest-add'.
* guix/profiles.scm (manifest-add): New procedure. * tests/profiles.scm (guile-1.8.8): New variable. ("manifest-add"): New test. Signed-off-by: Ludovic Courtès <ludo@gnu.org>
-rw-r--r--guix/profiles.scm20
-rw-r--r--tests/profiles.scm21
2 files changed, 41 insertions, 0 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 5e69e012f9..c7aec7909b 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -47,6 +47,7 @@
manifest-pattern?
manifest-remove
+ manifest-add
manifest-installed?
manifest-matching-entries
@@ -196,6 +197,25 @@ must be a manifest-pattern."
(manifest-entries manifest)
patterns)))
+(define (manifest-add manifest entries)
+ "Add a list of manifest ENTRIES to MANIFEST and return new manifest.
+Remove MANIFEST entries that have the same name and output as ENTRIES."
+ (define (same-entry? entry name output)
+ (match entry
+ (($ <manifest-entry> entry-name _ entry-output _ ...)
+ (and (equal? name entry-name)
+ (equal? output entry-output)))))
+
+ (make-manifest
+ (append entries
+ (fold (lambda (entry result)
+ (match entry
+ (($ <manifest-entry> name _ out _ ...)
+ (filter (negate (cut same-entry? <> name out))
+ result))))
+ (manifest-entries manifest)
+ entries))))
+
(define (manifest-installed? manifest pattern)
"Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
#f otherwise."
diff --git a/tests/profiles.scm b/tests/profiles.scm
index d405f6453e..b2919d7315 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -40,6 +40,13 @@
;; Example manifest entries.
+(define guile-1.8.8
+ (manifest-entry
+ (name "guile")
+ (version "1.8.8")
+ (item "/gnu/store/...")
+ (output "out")))
+
(define guile-2.0.9
(manifest-entry
(name "guile")
@@ -101,6 +108,20 @@
(null? (manifest-entries m3))
(null? (manifest-entries m4)))))))
+(test-assert "manifest-add"
+ (let* ((m0 (manifest '()))
+ (m1 (manifest-add m0 (list guile-1.8.8)))
+ (m2 (manifest-add m1 (list guile-2.0.9)))
+ (m3 (manifest-add m2 (list guile-2.0.9:debug)))
+ (m4 (manifest-add m3 (list guile-2.0.9:debug))))
+ (and (match (manifest-entries m1)
+ ((($ <manifest-entry> "guile" "1.8.8" "out")) #t)
+ (_ #f))
+ (match (manifest-entries m2)
+ ((($ <manifest-entry> "guile" "2.0.9" "out")) #t)
+ (_ #f))
+ (equal? m3 m4))))
+
(test-assert "profile-derivation"
(run-with-store %store
(mlet* %store-monad