02/03: guix package: '--search' sorts by relevance.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 4e863eb35fd8337eab48928e7733b7f6b7b2c242
Author: Ludovic Courtès <address@hidden>
Date:   Tue Jun 13 23:04:05 2017 +0200

    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.
---
 doc/guix.texi            | 14 ++++++---
 guix/scripts/package.scm | 76 ++++++++++++++++++++++++++++++------------------
 2 files changed, 58 insertions(+), 32 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index ffd2028..b5538e0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -1854,7 +1854,7 @@ availability of packages:
 @itemx -s @var{regexp}
 @cindex searching for packages
 List the available packages whose name, synopsis, or description matches
address@hidden  Print all the metadata of matching packages in
address@hidden, sorted by relevance.  Print all the metadata of matching 
packages in
 @code{recutils} format (@pxref{Top, GNU recutils databases,, recutils,
 GNU recutils manual}).
 
@@ -1862,12 +1862,18 @@ This allows specific fields to be extracted using the 
@command{recsel}
 command, for instance:
 
 @example
-$ guix package -s malloc | recsel -p name,version
+$ guix package -s malloc | recsel -p name,version,relevance
+name: jemalloc
+version: 4.5.0
+relevance: 6
+
 name: glibc
-version: 2.17
+version: 2.25
+relevance: 1
 
 name: libgc
-version: 7.2alpha6
+version: 7.6.0
+relevance: 1
 @end example
 
 Similarly, to show the name of all the packages available under the
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f050fad..a6bfb03 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)