ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

ui: 'relevance' considers regexps connected with a logical and.

Browse source 
* 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:
Ludovic Courtès 2019-06-25 22:59:58 +02:00
parent c25b44d640
commit 8874faaaac
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 40 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

25
guix/ui.scm
View file

@ -1256,17 +1256,20 @@ (define (relevance obj regexps metrics)
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
View file

@ -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 @@ (define-module (test-ui)
#: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 @@ (define guile-2.0.9
"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")