[bug#39258] [PATCH 2/4] ui: Use string matching with literal search strings.

[Arun Isaac <arunisaac@systemreboot.net>]

* 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