From 4e863eb35fd8337eab48928e7733b7f6b7b2c242 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Tue, 13 Jun 2017 23:04:05 +0200
Subject: guix package: '--search' sorts by relevance.

* guix/scripts/package.scm (find-packages-by-description): Rewrite to
compute a score based on the number of regexps matched and the number of
matches for each regexp.  Sort according to this score and return it as
a second value.
(process-query) <'search>: Capture the two return values of
'find-packages-by-description'.  Pass #:extra-fields to
'package->recutils'.
* doc/guix.texi (Invoking guix package): Mention relevance, give an
example.
---
 guix/scripts/package.scm | 76 ++++++++++++++++++++++++++++++------------------
 1 file changed, 48 insertions(+), 28 deletions(-)

(limited to 'guix')

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f050fad976..a6bfb03ae4 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -39,6 +39,7 @@
                 #:select (directory-exists? mkdir-p))
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
@@ -238,32 +239,45 @@ specified in MANIFEST, a manifest object."
 ;;;
 
 (define (find-packages-by-description regexps)
-  "Return the list of packages whose name matches one of REGEXPS, or whose
-synopsis or description matches all of REGEXPS."
-  (define version<? (negate version>=?))
-
-  (define (matches-all? str)
-    (every (cut regexp-exec <> str) regexps))
-
-  (define (matches-one? str)
-    (find (cut regexp-exec <> str) regexps))
-
-  (sort
-   (fold-packages (lambda (package result)
-                    (if (or (matches-one? (package-name package))
-                            (and=> (package-synopsis package)
-                                   (compose matches-all? P_))
-                            (and=> (package-description package)
-                                   (compose matches-all? P_)))
-                        (cons package result)
-                        result))
-                  '())
-   (lambda (p1 p2)
-     (case (string-compare (package-name p1) (package-name p2)
-                           (const '<) (const '=) (const '>))
-       ((=)  (version<? (package-version p1) (package-version p2)))
-       ((<)  #t)
-       (else #f)))))
+  "Return two values: the list of packages whose name, synopsis, or
+description matches at least one of REGEXPS sorted by relevance, and the list
+of relevance scores."
+  (define (score str)
+    (let ((counts (filter-map (lambda (regexp)
+                                (match (regexp-exec regexp str)
+                                  (#f #f)
+                                  (m  (match:count m))))
+                              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 (package-score package)
+    (+ (* 3 (score (package-name package)))
+       (* 2 (match (package-synopsis package)
+              ((? string? str) (score (P_ str)))
+              (#f              0)))
+       (match (package-description package)
+         ((? string? str) (score (P_ str)))
+         (#f              0))))
+
+  (let ((matches (fold-packages (lambda (package result)
+                                  (match (package-score package)
+                                    ((? zero?)
+                                     result)
+                                    (score
+                                     (cons (list package score) result))))
+                                '())))
+    (unzip2 (sort matches
+                  (lambda (m1 m2)
+                    (match m1
+                      ((package1 score1)
+                       (match m2
+                         ((package2 score2)
+                          (if (= score1 score2)
+                              (string>? (package-full-name package1)
+                                        (package-full-name package2))
+                              (> score1 score2)))))))))))
 
 (define (transaction-upgrade-entry entry transaction)
   "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
@@ -752,8 +766,14 @@ processed, #f otherwise."
                                     opts))
               (regexps  (map (cut make-regexp* <> regexp/icase) patterns)))
          (leave-on-EPIPE
-          (for-each (cute package->recutils <> (current-output-port))
-                    (find-packages-by-description regexps)))
+          (let-values (((packages scores)
+                        (find-packages-by-description regexps)))
+            (for-each (lambda (package score)
+                        (package->recutils package (current-output-port)
+                                           #:extra-fields
+                                           `((relevance . ,score))))
+                      packages
+                      scores)))
          #t))
 
       (('show requested-name)
-- 
cgit v1.2.3