[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: guix package: '--search' sorts by relevance.
From: |
Ludovic Courtès |
Subject: |
02/03: guix package: '--search' sorts by relevance. |
Date: |
Tue, 13 Jun 2017 17:22:41 -0400 (EDT) |
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)