mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 06:06:53 -05:00
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>
This commit is contained in:
parent
599f146400
commit
f755403014
2 changed files with 41 additions and 0 deletions
|
@ -47,6 +47,7 @@ (define-module (guix profiles)
|
||||||
manifest-pattern?
|
manifest-pattern?
|
||||||
|
|
||||||
manifest-remove
|
manifest-remove
|
||||||
|
manifest-add
|
||||||
manifest-installed?
|
manifest-installed?
|
||||||
manifest-matching-entries
|
manifest-matching-entries
|
||||||
|
|
||||||
|
@ -196,6 +197,25 @@ (define (remove-entry pattern lst)
|
||||||
(manifest-entries manifest)
|
(manifest-entries manifest)
|
||||||
patterns)))
|
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)
|
(define (manifest-installed? manifest pattern)
|
||||||
"Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
|
"Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern),
|
||||||
#f otherwise."
|
#f otherwise."
|
||||||
|
|
|
@ -40,6 +40,13 @@ (define guile-for-build
|
||||||
|
|
||||||
;; Example manifest entries.
|
;; 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
|
(define guile-2.0.9
|
||||||
(manifest-entry
|
(manifest-entry
|
||||||
(name "guile")
|
(name "guile")
|
||||||
|
@ -101,6 +108,20 @@ (define guile-2.0.9:debug
|
||||||
(null? (manifest-entries m3))
|
(null? (manifest-entries m3))
|
||||||
(null? (manifest-entries m4)))))))
|
(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"
|
(test-assert "profile-derivation"
|
||||||
(run-with-store %store
|
(run-with-store %store
|
||||||
(mlet* %store-monad
|
(mlet* %store-monad
|
||||||
|
|
Loading…
Reference in a new issue