aboutsummaryrefslogtreecommitdiff
path: root/guix/profiles.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/profiles.scm')
-rw-r--r--guix/profiles.scm34
1 files changed, 24 insertions, 10 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,