From 8874faaaac665100a095ef25e39c9a389f5a397f Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 25 Jun 2019 22:59:58 +0200
Subject: ui: 'relevance' considers regexps connected with a logical and.

* guix/ui.scm (relevance)[score]: Change to return 0 when one of REGEXPS
doesn't match.
* tests/ui.scm ("package-relevance"): New test.
---
 guix/ui.scm  | 25 ++++++++++++++-----------
 tests/ui.scm | 27 ++++++++++++++++++++++++++-
 2 files changed, 40 insertions(+), 12 deletions(-)

diff --git a/guix/ui.scm b/guix/ui.scm
index 0b4fe144b6..d9dbe4a652 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -1256,17 +1256,20 @@ 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 str)
-    (let ((counts (map (lambda (regexp)
-                         (match (fold-matches regexp str '() cons)
-                           (()  0)
-                           ((m) (if (string=? (match:substring m) str)
-                                    5              ;exact match
-                                    1))
-                           (lst (length lst))))
-                       regexps)))
-      ;; Compute a score that's proportional to the number of regexps matched
-      ;; and to the number of matches for each regexp.
-      (* (length counts) (reduce + 0 counts))))
+    (define scores
+      (map (lambda (regexp)
+             (fold-matches regexp str 0
+                           (lambda (m score)
+                             (+ score
+                                (if (string=? (match:substring m) str)
+                                    5             ;exact match
+                                    1)))))
+           regexps))
+
+    ;; Return zero if one of REGEXPS doesn't match.
+    (if (any zero? scores)
+        0
+        (reduce + 0 scores)))
 
   (fold (lambda (metric relevance)
           (match metric
diff --git a/tests/ui.scm b/tests/ui.scm
index 1e98e3534b..2138e23369 100644
--- a/tests/ui.scm
+++ b/tests/ui.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -22,10 +22,12 @@
   #:use-module (guix profiles)
   #:use-module (guix store)
   #:use-module (guix derivations)
+  #:use-module ((gnu packages) #:select (specification->package))
   #:use-module (guix tests)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-64)
   #:use-module (ice-9 regex))
 
@@ -260,4 +262,27 @@ Second line" 24))
                                                  "ISO-8859-1")
                              (show-manifest-transaction store m t))))))))
 
+(test-assert "package-relevance"
+  (let ((guile  (specification->package "guile"))
+        (gcrypt (specification->package "guile-gcrypt"))
+        (go     (specification->package "go"))
+        (gnugo  (specification->package "gnugo"))
+        (rx     (cut make-regexp <> regexp/icase))
+        (>0     (cut > <> 0))
+        (=0     zero?))
+    (and (>0 (package-relevance guile
+                                (map rx '("scheme"))))
+         (>0 (package-relevance guile
+                                (map rx '("scheme" "implementation"))))
+         (>0 (package-relevance gcrypt
+                                (map rx '("guile" "crypto"))))
+         (=0 (package-relevance guile
+                                (map rx '("guile" "crypto"))))
+         (>0 (package-relevance go
+                                (map rx '("go"))))
+         (=0 (package-relevance go
+                                (map rx '("go" "game"))))
+         (>0 (package-relevance gnugo
+                                (map rx '("go" "game")))))))
+
 (test-end "ui")
-- 
cgit v1.2.3