[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#39258] [PATCH 2/4] ui: Use string matching with literal search stri
From: |
Arun Isaac |
Subject: |
[bug#39258] [PATCH 2/4] ui: Use string matching with literal search strings. |
Date: |
Mon, 1 Jun 2020 05:30:28 +0530 |
* guix/scripts/package.scm (process-query): Make search query a regexp only if
it is not a literal search string.
* guix/ui.scm (relevance): Use string matching with literal search strings and
regexp matching with regexp search strings.
---
guix/scripts/package.scm | 12 +++++++---
guix/ui.scm | 50 +++++++++++++++++++++++++---------------
2 files changed, 40 insertions(+), 22 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 1246147798..1b637f7802 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -675,6 +675,11 @@ doesn't need it."
(define (process-query opts)
"Process any query specified by OPTS. Return #t when a query was actually
processed, #f otherwise."
+ (define (regexp-pattern? str)
+ (string-any
+ (char-set #\. #\[ #\{ #\} #\( #\) #\\ #\* #\+ #\? #\| #\^ #\$)
+ str))
+
(let* ((profiles (delete-duplicates
(match (filter-map (match-lambda
(('profile . p) p)
@@ -781,11 +786,12 @@ processed, #f otherwise."
(('search _)
(let* ((patterns (filter-map (match-lambda
- (('query 'search rx) rx)
+ (('query 'search (? regexp-pattern? rx))
+ (make-regexp* rx regexp/icase))
+ (('query 'search pattern) pattern)
(_ #f))
opts))
- (regexps (map (cut make-regexp* <> regexp/icase) patterns))
- (matches (find-packages-by-description regexps)))
+ (matches (find-packages-by-description patterns)))
(leave-on-EPIPE
(display-search-results matches (current-output-port)))
#t))
diff --git a/guix/ui.scm b/guix/ui.scm
index 4a22358963..56754dba83 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1489,41 +1489,53 @@ HYPERLINKS? is true, emit hyperlink escape sequences
when appropriate."
;;; Searching.
;;;
-(define (relevance obj regexps metrics)
+(define (relevance obj patterns metrics)
"Compute a \"relevance score\" for OBJ as a function of its number of
-matches of REGEXPS and accordingly to METRICS. METRICS is list of
+matches of PATTERNS and accordingly to METRICS. METRICS is list of
field/weight pairs, where FIELD is a procedure that returns a string or list
of strings describing OBJ, and WEIGHT is a positive integer denoting the
weight of this field in the final score.
-A score of zero means that OBJ does not match any of REGEXPS. The higher the
-score, the more relevant OBJ is to REGEXPS."
- (define (score regexp str)
- (fold-matches regexp str 0
- (lambda (m score)
- (+ score
- (if (string=? (match:substring m) str)
- 5 ;exact match
- 1)))))
-
- (define (regexp->score regexp)
- (let ((score-regexp (lambda (str) (score regexp str))))
+A score of zero means that OBJ does not match any of PATTERNS. The higher the
+score, the more relevant OBJ is to PATTERNS."
+ (define (score pattern str)
+ (match pattern
+ ((? string? pattern)
+ (cond
+ ((string=? str pattern) 5)
+ (else
+ (let loop ((score 0) (start 0))
+ (cond
+ ((string-contains-ci str pattern start)
+ => (lambda (index)
+ (loop (+ score 1) (+ index (string-length pattern)))))
+ (else score))))))
+ ((? regexp? regexp)
+ (fold-matches regexp str 0
+ (lambda (m score)
+ (+ score
+ (if (string=? (match:substring m) str)
+ 5 ;exact match
+ 1)))))))
+
+ (define (pattern->score pattern)
+ (let ((score-pattern (lambda (str) (score pattern str))))
(fold (lambda (metric relevance)
(match metric
((field . weight)
(match (field obj)
(#f relevance)
((? string? str)
- (+ relevance (* (score-regexp str) weight)))
+ (+ relevance (* (score-pattern str) weight)))
((lst ...)
- (+ relevance (* weight (apply + (map score-regexp
lst)))))))))
+ (+ relevance (* weight (apply + (map score-pattern
lst)))))))))
0 metrics)))
- (let loop ((regexps regexps)
+ (let loop ((patterns patterns)
(total-score 0))
- (match regexps
+ (match patterns
((head . tail)
- (let ((score (regexp->score head)))
+ (let ((score (pattern->score head)))
;; Return zero if one of PATTERNS doesn't match.
(cond
((zero? score) 0)
--
2.26.2