~ruther/guix-local

f755403014e70d875541bcce5474d2cf410b5da1 — Alex Kost 11 years ago 599f146
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>
2 files changed, 41 insertions(+), 0 deletions(-)

M guix/profiles.scm
M tests/profiles.scm
M guix/profiles.scm => guix/profiles.scm +20 -0
@@ 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."

M tests/profiles.scm => tests/profiles.scm +21 -0
@@ 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