From a20787706c246a9451b69db075a30ee91d28538b Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 1 Nov 2013 23:11:17 +0100
Subject: 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.
---
 guix/scripts/package.scm | 26 ++++++++++++++++----------
 1 file changed, 16 insertions(+), 10 deletions(-)

(limited to 'guix/scripts/package.scm')

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index e0c7b6ed15..77406c7f39 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -693,15 +693,20 @@ return the new list of manifest entries."
   (append to-upgrade to-install))
 
 (define (options->removable options manifest)
-  "Given options, return the list of manifest entries to be removed from
-MANIFEST."
-  (let ((remove (filter-map (match-lambda
-                             (('remove . package)
-                              package)
-                             (_ #f))
-                            options)))
-    (filter (cut manifest-installed? manifest <>)
-            remove)))
+  "Given options, return the list of manifest patterns of packages to be
+removed from MANIFEST."
+  (filter-map (match-lambda
+               (('remove . spec)
+                (call-with-values
+                    (lambda ()
+                      (package-specification->name+version+output spec))
+                  (lambda (name version output)
+                    (manifest-pattern
+                      (name name)
+                      (version version)
+                      (output output)))))
+               (_ #f))
+              options))
 
 
 ;;;
@@ -871,7 +876,8 @@ more information.~%"))
 
              (if (manifest=? new manifest)
                  (format (current-error-port) (_ "nothing to be done~%"))
-                 (let ((prof-drv (profile-derivation (%store) new)))
+                 (let ((prof-drv (profile-derivation (%store) new))
+                       (remove   (manifest-matching-entries manifest remove)))
                    (show-what-to-remove/install remove install dry-run?)
                    (show-what-to-build (%store) (list prof-drv)
                                        #:use-substitutes?
-- 
cgit v1.2.3