diff options
author | Ludovic Courtès <ludo@gnu.org> | 2013-11-01 23:11:17 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2013-11-01 23:21:01 +0100 |
commit | a20787706c246a9451b69db075a30ee91d28538b (patch) | |
tree | 5fb67cad6b5f65d4aa4be73966d5747c276f4ba2 /guix/profiles.scm | |
parent | 537630c5a743251024b6bbd8b4eecf8811439cc6 (diff) | |
download | gnu-guix-a20787706c246a9451b69db075a30ee91d28538b.tar gnu-guix-a20787706c246a9451b69db075a30ee91d28538b.tar.gz |
guix package: Allow removal of a specific package output.
Fixes <http://bugs.gnu.org/15756>.
* guix/profiles.scm (<manifest-pattern>): New record type.
(remove-manifest-entry): Remove.
(entry-predicate, manifest-matching-entries): New procedures.
(manifest-remove): Accept a list of <manifest-pattern>.
(manifest-installed?): Replace 'name' parameter by 'pattern', a
<manifest-pattern>.
* guix/scripts/package.scm (options->removable): Return a list of
<manifest-pattern>.
(guix-package)[process-action]: Use 'manifest-matching-entries' to
compute the list of packages to remove.
* tests/profiles.scm: New file.
* Makefile.am (SCM_TESTS): Add it.
Diffstat (limited to 'guix/profiles.scm')
-rw-r--r-- | guix/profiles.scm | 70 |
1 files changed, 51 insertions, 19 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 528f3c574b..1f62099e45 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -42,11 +42,15 @@ manifest-entry-path manifest-entry-dependencies + manifest-pattern + manifest-pattern? + read-manifest write-manifest manifest-remove manifest-installed? + manifest-matching-entries manifest=? profile-manifest @@ -90,6 +94,15 @@ (inputs manifest-entry-inputs ; list of inputs to build (default '()))) ; this entry +(define-record-type* <manifest-pattern> manifest-pattern + make-manifest-pattern + manifest-pattern? + (name manifest-pattern-name) ; string + (version manifest-pattern-version ; string | #f + (default #f)) + (output manifest-pattern-output ; string | #f + (default "out"))) + (define (profile-manifest profile) "Return the PROFILE's manifest." (let ((file (string-append profile "/manifest"))) @@ -148,29 +161,48 @@ "Write MANIFEST to PORT." (write (manifest->sexp manifest) port)) -(define (remove-manifest-entry name lst) - "Remove the manifest entry named NAME from LST." - (remove (match-lambda - (($ <manifest-entry> entry-name) - (string=? name entry-name))) - lst)) - -(define (manifest-remove manifest names) - "Remove entries for each of NAMES from MANIFEST." - (make-manifest (fold remove-manifest-entry +(define (entry-predicate pattern) + "Return a procedure that returns #t when passed a manifest entry that +matches NAME/OUTPUT/VERSION. OUTPUT and VERSION may be #f, in which case they +are ignored." + (match pattern + (($ <manifest-pattern> name version output) + (match-lambda + (($ <manifest-entry> entry-name entry-version entry-output) + (and (string=? entry-name name) + (or (not entry-output) (not output) + (string=? entry-output output)) + (or (not version) + (string=? entry-version version)))))))) + +(define (manifest-remove manifest patterns) + "Remove entries for each of PATTERNS from MANIFEST. Each item in PATTERNS +must be a manifest-pattern." + (define (remove-entry pattern lst) + (remove (entry-predicate pattern) lst)) + + (make-manifest (fold remove-entry (manifest-entries manifest) - names))) - -(define (manifest-installed? manifest name) - "Return #t if MANIFEST has an entry for NAME, #f otherwise." - (define (->bool x) - (not (not x))) + patterns))) - (->bool (find (match-lambda - (($ <manifest-entry> entry-name) - (string=? entry-name name))) +(define (manifest-installed? manifest pattern) + "Return #t if MANIFEST has an entry matching PATTERN (a manifest-pattern), +#f otherwise." + (->bool (find (entry-predicate pattern) (manifest-entries manifest)))) +(define (manifest-matching-entries manifest patterns) + "Return all the entries of MANIFEST that match one of the PATTERNS." + (define predicates + (map entry-predicate patterns)) + + (define (matches? entry) + (any (lambda (pred) + (pred entry)) + predicates)) + + (filter matches? (manifest-entries manifest))) + (define (manifest=? m1 m2) "Return #t if manifests M1 and M2 are equal. This differs from 'equal?' in that the 'inputs' field is ignored for the comparison, since it is know to |