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
|
A score of zero means that OBJ does not match any of REGEXPS. The higher the
|
||||||
score, the more relevant OBJ is to REGEXPS."
|
score, the more relevant OBJ is to REGEXPS."
|
||||||
(define (score str)
|
(define (score str)
|
||||||
(let ((counts (map (lambda (regexp)
|
(define scores
|
||||||
(match (fold-matches regexp str '() cons)
|
(map (lambda (regexp)
|
||||||
(() 0)
|
(fold-matches regexp str 0
|
||||||
((m) (if (string=? (match:substring m) str)
|
(lambda (m score)
|
||||||
5 ;exact match
|
(+ score
|
||||||
1))
|
(if (string=? (match:substring m) str)
|
||||||
(lst (length lst))))
|
5 ;exact match
|
||||||
regexps)))
|
1)))))
|
||||||
;; Compute a score that's proportional to the number of regexps matched
|
regexps))
|
||||||
;; and to the number of matches for each regexp.
|
|
||||||
(* (length counts) (reduce + 0 counts))))
|
;; Return zero if one of REGEXPS doesn't match.
|
||||||
|
(if (any zero? scores)
|
||||||
|
0
|
||||||
|
(reduce + 0 scores)))
|
||||||
|
|
||||||
(fold (lambda (metric relevance)
|
(fold (lambda (metric relevance)
|
||||||
(match metric
|
(match metric
|
||||||
|
|
27
tests/ui.scm
27
tests/ui.scm
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -22,10 +22,12 @@
|
||||||
#:use-module (guix profiles)
|
#:use-module (guix profiles)
|
||||||
#:use-module (guix store)
|
#:use-module (guix store)
|
||||||
#:use-module (guix derivations)
|
#:use-module (guix derivations)
|
||||||
|
#:use-module ((gnu packages) #:select (specification->package))
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
#:use-module (srfi srfi-19)
|
#:use-module (srfi srfi-19)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-64)
|
#:use-module (srfi srfi-64)
|
||||||
#:use-module (ice-9 regex))
|
#:use-module (ice-9 regex))
|
||||||
|
|
||||||
|
@ -260,4 +262,27 @@ Second line" 24))
|
||||||
"ISO-8859-1")
|
"ISO-8859-1")
|
||||||
(show-manifest-transaction store m t))))))))
|
(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")
|
(test-end "ui")
|
||||||
|
|
Loading…
Reference in New Issue