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.
This commit is contained in:
parent
c25b44d640
commit
8874faaaac
25
guix/ui.scm
25
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
|
||||
|
27
tests/ui.scm
27
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")
|
||||
|
Loading…
Reference in New Issue
Block a user