profiles: Raise an error for unmatched patterns.

Previously, "guix package -r something-not-installed" would silently
complete.  Now an error is raised.

* guix/profiles.scm (&unmatched-pattern-error): New condition type.
(manifest-matching-entries): Rewrite to raise an error when one of
PATTERNS is not matched.
* guix/ui.scm (call-with-error-handling): Handle 'unmatched-pattern-error?'.
* tests/guix-package.sh: Add test.
* tests/profiles.scm ("manifest-matching-entries"): Don't try to remove
unmatched pattern.
("manifest-matching-entries, no match"): New test.
("manifest-transaction-effects"): Remove 'remove' field.

4 files changed, 49 insertions, 17 deletions

diff --git a/guix/profiles.scm b/guix/profiles.scm
index efe5ecb9dc..6564526aee 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -63,6 +63,10 @@
             &missing-generation-error
             missing-generation-error?
             missing-generation-error-generation
+            &unmatched-pattern-error
+            unmatched-pattern-error?
+            unmatched-pattern-error-pattern
+            unmatched-pattern-error-manifest
 
             manifest make-manifest
             manifest?
@@ -156,6 +160,11 @@
   (entry    profile-collision-error-entry)        ;<manifest-entry>
   (conflict profile-collision-error-conflict))    ;<manifest-entry>
 
+(define-condition-type &unmatched-pattern-error &error
+  unmatched-pattern-error?
+  (pattern  unmatched-pattern-error-pattern)      ;<manifest-pattern>
+  (manifest unmatched-pattern-error-manifest))    ;<manifest>
+
 (define-condition-type &missing-generation-error &profile-error
   missing-generation-error?
   (generation missing-generation-error-generation))
@@ -559,16 +568,21 @@ no match.."
   (->bool (manifest-lookup manifest pattern)))
 
 (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)))
+  "Return all the entries of MANIFEST that match one of the PATTERNS.  Raise
+an '&unmatched-pattern-error' if none of the entries of MANIFEST matches one
+of PATTERNS."
+  (fold-right (lambda (pattern matches)
+                (match (filter (entry-predicate pattern)
+                               (manifest-entries manifest))
+                  (()
+                   (raise (condition
+                           (&unmatched-pattern-error
+                            (pattern pattern)
+                            (manifest manifest)))))
+                  (lst
+                   (append lst matches))))
+              '()
+              patterns))
 
 (define (manifest-search-paths manifest)
   "Return the list of search path specifications that apply to MANIFEST,
diff --git a/guix/ui.scm b/guix/ui.scm
index 9eab4ba3f7..f0465519b6 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -643,6 +643,14 @@ or remove one of them from the profile.")
              (leave (G_ "generation ~a of profile '~a' does not exist~%")
                     (missing-generation-error-generation c)
                     (profile-error-profile c)))
+            ((unmatched-pattern-error? c)
+             (let ((pattern (unmatched-pattern-error-pattern c)))
+               (leave (G_ "package '~a~@[@~a~]~@[:~a~]' not found in profile~%")
+                      (manifest-pattern-name pattern)
+                      (manifest-pattern-version pattern)
+                      (match (manifest-pattern-output pattern)
+                        ("out" #f)
+                        (output output)))))
             ((profile-collision-error? c)
              (let ((entry    (profile-collision-error-entry c))
                    (conflict (profile-collision-error-conflict c)))
diff --git a/tests/guix-package.sh b/tests/guix-package.sh
index 7eeb4304d1..0d60481895 100644
--- a/tests/guix-package.sh
+++ b/tests/guix-package.sh
@@ -1,5 +1,5 @@
 # GNU Guix --- Functional package management for GNU
-# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
 #
 # This file is part of GNU Guix.
@@ -97,6 +97,11 @@ then false; else true; fi
 if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile";
 then false; else true; fi
 
+# Make sure we get an error when trying to remove something that's not
+# installed.
+if guix package --bootstrap -r something-not-installed -p "$profile";
+then false; else true; fi
+
 # Check whether `--list-available' returns something sensible.
 guix package -p "$profile" -A 'gui.*e' | grep guile
 
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 9a05030aff..eef93e24cf 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -93,10 +93,7 @@
 (test-assert "manifest-matching-entries"
   (let* ((e (list guile-2.0.9 guile-2.0.9:debug))
          (m (manifest e)))
-    (and (null? (manifest-matching-entries m
-                                           (list (manifest-pattern
-                                                   (name "python")))))
-         (equal? e
+    (and (equal? e
                  (manifest-matching-entries m
                                             (list (manifest-pattern
                                                     (name "guile")
@@ -107,6 +104,15 @@
                                                     (name "guile")
                                                     (version "2.0.9"))))))))
 
+(test-assert "manifest-matching-entries, no match"
+  (let ((m (manifest (list guile-2.0.9)))
+        (p (manifest-pattern (name "python"))))
+    (guard (c ((unmatched-pattern-error? c)
+               (and (eq? p (unmatched-pattern-error-pattern c))
+                    (eq? m (unmatched-pattern-error-manifest c)))))
+      (manifest-matching-entries m (list p))
+      #f)))
+
 (test-assert "manifest-remove"
   (let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
          (m1 (manifest-remove m0
@@ -165,8 +171,7 @@
 (test-assert "manifest-transaction-effects"
   (let* ((m0 (manifest (list guile-1.8.8)))
          (t  (manifest-transaction
-              (install (list guile-2.0.9 glibc))
-              (remove (list (manifest-pattern (name "coreutils")))))))
+              (install (list guile-2.0.9 glibc)))))
     (let-values (((remove install upgrade downgrade)
                   (manifest-transaction-effects m0 t)))
       (and (null? remove) (null? downgrade)