>From af4b8495969d70d59aa9f3f296628daeaf80b0d2 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Tue, 12 Aug 2014 12:32:16 +0400 Subject: [PATCH 1/2] profiles: Add 'manifest-add'. * guix/profiles.scm (manifest-add): New procedure. * tests/profiles.scm (guile-1.8.8): New variable. ("manifest-add"): New test. --- guix/profiles.scm | 20 ++++++++++++++++++++ tests/profiles.scm | 21 +++++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/guix/profiles.scm b/guix/profiles.scm index 5e69e01..c7aec79 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 + (($ entry-name _ entry-output _ ...) + (and (equal? name entry-name) + (equal? output entry-output))))) + + (make-manifest + (append entries + (fold (lambda (entry result) + (match 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 d405f64..b2919d7 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) + ((($ "guile" "1.8.8" "out")) #t) + (_ #f)) + (match (manifest-entries m2) + ((($ "guile" "2.0.9" "out")) #t) + (_ #f)) + (equal? m3 m4)))) + (test-assert "profile-derivation" (run-with-store %store (mlet* %store-monad -- 2.0.3