* [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display
@ 2019-06-26 8:43 Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
2019-06-26 9:57 ` [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ricardo Wurmus
0 siblings, 2 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:43 UTC (permalink / raw)
To: 36390
Hello Guix!
This improves ‘guix search’ in two ways:
1. The relevance score now excludes things that do not match *all*
the regexps. So ‘guix search go game’ returns 28 results instead
of 1,245 and the first one is ‘gnugo’; ‘guix search ssh client’
returns 14 results instead of 510; ‘guix search guile crypto’
returns just ‘guile-gcrypt’ instead of 279 results.
2. ‘guix search’ and ‘guix system search’ now write at most a full
screen of results. You can pipe through a pager to view all the
results.
Thoughts?
Ludo’.
Ludovic Courtès (3):
ui: 'relevance' considers regexps connected with a logical and.
syscalls: Add 'terminal-rows'.
ui: Add 'display-search-results' and use it.
guix/build/syscalls.scm | 37 +++++++++++------
guix/scripts/package.scm | 41 ++++++++-----------
guix/scripts/system/search.scm | 44 +++++++++-----------
guix/ui.scm | 75 ++++++++++++++++++++++++++++------
tests/syscalls.scm | 5 ++-
tests/ui.scm | 27 +++++++++++-
6 files changed, 155 insertions(+), 74 deletions(-)
--
2.22.0
^ permalink raw reply [flat|nested] 6+ messages in thread
* [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and.
2019-06-26 8:43 [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ludovic Courtès
@ 2019-06-26 8:59 ` Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows' Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it Ludovic Courtès
2019-06-26 9:57 ` [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ricardo Wurmus
1 sibling, 2 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:59 UTC (permalink / raw)
To: 36390
* guix/ui.scm (relevance)[score]: Change to return 0 when one of REGEXPS
doesn't match.
* tests/ui.scm ("package-relevance"): New test.
---
guix/ui.scm | 25 ++++++++++++++-----------
tests/ui.scm | 27 ++++++++++++++++++++++++++-
2 files changed, 40 insertions(+), 12 deletions(-)
diff --git a/guix/ui.scm b/guix/ui.scm
index 0b4fe144b6..d9dbe4a652 100644
--- a/guix/ui.scm
+++ b/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
diff --git a/tests/ui.scm b/tests/ui.scm
index 1e98e3534b..2138e23369 100644
--- a/tests/ui.scm
+++ b/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")
--
2.22.0
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows'.
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
@ 2019-06-26 8:59 ` Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it Ludovic Courtès
1 sibling, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:59 UTC (permalink / raw)
To: 36390
* guix/build/syscalls.scm (terminal-dimension): New procedure.
(terminal-columns): Rewrite in terms of 'terminal-dimension'.
(terminal-rows): New procedure.
* tests/syscalls.scm ("terminal-rows"): New test.
---
guix/build/syscalls.scm | 37 +++++++++++++++++++++++++------------
tests/syscalls.scm | 5 ++++-
2 files changed, 29 insertions(+), 13 deletions(-)
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5c2eb3c14d..eb045cbd1c 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -146,6 +146,7 @@
window-size-y-pixels
terminal-window-size
terminal-columns
+ terminal-rows
utmpx?
utmpx-login-type
@@ -1871,23 +1872,17 @@ corresponds to the TIOCGWINSZ ioctl."
(list (strerror err))
(list err)))))
-(define* (terminal-columns #:optional (port (current-output-port)))
- "Return the best approximation of the number of columns of the terminal at
-PORT, trying to guess a reasonable value if all else fails. The result is
-always a positive integer."
- (define (fall-back)
- (match (and=> (getenv "COLUMNS") string->number)
- (#f 80)
- ((? number? columns)
- (if (> columns 0) columns 80))))
-
+(define (terminal-dimension window-dimension port fall-back)
+ "Return the terminal dimension defined by WINDOW-DIMENSION, one of
+'window-size-columns' or 'window-size-rows' for PORT. If PORT does not
+correspond to a terminal, return the value returned by FALL-BACK."
(catch 'system-error
(lambda ()
(if (file-port? port)
- (match (window-size-columns (terminal-window-size port))
+ (match (window-dimension (terminal-window-size port))
;; Things like Emacs shell-mode return 0, which is unreasonable.
(0 (fall-back))
- ((? number? columns) columns))
+ ((? number? n) n))
(fall-back)))
(lambda args
(let ((errno (system-error-errno args)))
@@ -1900,6 +1895,24 @@ always a positive integer."
(fall-back)
(apply throw args))))))
+(define* (terminal-columns #:optional (port (current-output-port)))
+ "Return the best approximation of the number of columns of the terminal at
+PORT, trying to guess a reasonable value if all else fails. The result is
+always a positive integer."
+ (define (fall-back)
+ (match (and=> (getenv "COLUMNS") string->number)
+ (#f 80)
+ ((? number? columns)
+ (if (> columns 0) columns 80))))
+
+ (terminal-dimension window-size-columns port fall-back))
+
+(define* (terminal-rows #:optional (port (current-output-port)))
+ "Return the best approximation of the number of rows of the terminal at
+PORT, trying to guess a reasonable value if all else fails. The result is
+always a positive integer."
+ (terminal-dimension window-size-rows port (const 25)))
+
\f
;;;
;;; utmpx.
diff --git a/tests/syscalls.scm b/tests/syscalls.scm
index 3e267c9f01..eeb223b950 100644
--- a/tests/syscalls.scm
+++ b/tests/syscalls.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;;
;;; This file is part of GNU Guix.
@@ -538,6 +538,9 @@
(> (terminal-columns (open-input-string "Join us now, share the software!"))
0))
+(test-assert "terminal-rows"
+ (> (terminal-rows) 0))
+
(test-assert "utmpx-entries"
(match (utmpx-entries)
(((? utmpx? entries) ...)
--
2.22.0
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it.
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows' Ludovic Courtès
@ 2019-06-26 8:59 ` Ludovic Courtès
1 sibling, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-26 8:59 UTC (permalink / raw)
To: 36390
* guix/ui.scm (display-search-results): New procedure.
* guix/scripts/package.scm (find-packages-by-description): Remove
'unzip2' call and return a list of pairs.
(process-query): Change to use 'display-search-results'.
* guix/scripts/system/search.scm (find-service-types): Remove 'unzip2'
call and return a list of pairs.
(guix-system-search): Use 'display-search-results'.
---
guix/scripts/package.scm | 41 ++++++++++++----------------
guix/scripts/system/search.scm | 44 +++++++++++++-----------------
guix/ui.scm | 50 +++++++++++++++++++++++++++++++++-
3 files changed, 86 insertions(+), 49 deletions(-)
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 5751123525..7b277b63f1 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -26,6 +26,7 @@
(define-module (guix scripts package)
#:use-module (guix ui)
#:use-module ((guix status) #:select (with-status-verbosity))
+ #:use-module ((guix build syscalls) #:select (terminal-rows))
#:use-module (guix store)
#:use-module (guix grafts)
#:use-module (guix derivations)
@@ -178,9 +179,9 @@ hooks\" run when building the profile."
;;;
(define (find-packages-by-description regexps)
- "Return two values: the list of packages whose name, synopsis, description,
-or output matches at least one of REGEXPS sorted by relevance, and the list of
-relevance scores."
+ "Return a list of pairs: packages whose name, synopsis, description,
+or output matches at least one of REGEXPS sorted by relevance, and its
+non-zero relevance score."
(let ((matches (fold-packages (lambda (package result)
(if (package-superseded package)
result
@@ -189,19 +190,19 @@ relevance scores."
((? zero?)
result)
(score
- (cons (list package score)
+ (cons (cons 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)))))))))))
+ (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
@@ -755,16 +756,10 @@ processed, #f otherwise."
(('query 'search rx) rx)
(_ #f))
opts))
- (regexps (map (cut make-regexp* <> regexp/icase) patterns)))
+ (regexps (map (cut make-regexp* <> regexp/icase) patterns))
+ (matches (find-packages-by-description regexps)))
(leave-on-EPIPE
- (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)))
+ (display-search-results matches (current-output-port)))
#t))
(('show requested-name)
diff --git a/guix/scripts/system/search.scm b/guix/scripts/system/search.scm
index 955cdd1e95..5278062edd 100644
--- a/guix/scripts/system/search.scm
+++ b/guix/scripts/system/search.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
@@ -139,9 +139,8 @@ columns."
. 1)))
(define (find-service-types regexps)
- "Return two values: the list of service types whose name or description
-matches at least one of REGEXPS sorted by relevance, and the list of relevance
-scores."
+ "Return a list of service type/score pairs: service types whose name or
+description matches REGEXPS sorted by relevance, and their score."
(let ((matches (fold-service-types
(lambda (type result)
(match (relevance type regexps
@@ -149,30 +148,25 @@ scores."
((? zero?)
result)
(score
- (cons (list type score) result))))
+ (cons (cons type score) result))))
'())))
- (unzip2 (sort matches
- (lambda (m1 m2)
- (match m1
- ((type1 score1)
- (match m2
- ((type2 score2)
- (if (= score1 score2)
- (string>? (service-type-name* type1)
- (service-type-name* type2))
- (> score1 score2)))))))))))
+ (sort matches
+ (lambda (m1 m2)
+ (match m1
+ ((type1 . score1)
+ (match m2
+ ((type2 . score2)
+ (if (= score1 score2)
+ (string>? (service-type-name* type1)
+ (service-type-name* type2))
+ (> score1 score2))))))))))
\f
(define (guix-system-search . args)
(with-error-handling
- (let ((regexps (map (cut make-regexp* <> regexp/icase) args)))
+ (let* ((regexps (map (cut make-regexp* <> regexp/icase) args))
+ (matches (find-service-types regexps)))
(leave-on-EPIPE
- (let-values (((services scores)
- (find-service-types regexps)))
- (for-each (lambda (service score)
- (service-type->recutils service
- (current-output-port)
- #:extra-fields
- `((relevance . ,score))))
- services
- scores))))))
+ (display-search-results matches (current-output-port)
+ #:print service-type->recutils
+ #:command "guix system search")))))
diff --git a/guix/ui.scm b/guix/ui.scm
index d9dbe4a652..363ef36dcd 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -46,7 +46,8 @@
#:use-module (guix serialization)
#:use-module ((guix licenses) #:select (license? license-name))
#:use-module ((guix build syscalls)
- #:select (free-disk-space terminal-columns))
+ #:select (free-disk-space terminal-columns
+ terminal-rows))
#:use-module ((guix build utils)
;; XXX: All we need are the bindings related to
;; '&invoke-error'. However, to work around the bug described
@@ -106,8 +107,11 @@
string->recutils
package->recutils
package-specification->name+version+output
+
relevance
package-relevance
+ display-search-results
+
string->generations
string->duration
matching-generations
@@ -1246,6 +1250,11 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
extra-fields)
(newline port))
+\f
+;;;
+;;; Searching.
+;;;
+
(define (relevance obj regexps metrics)
"Compute a \"relevance score\" for OBJ as a function of its number of
matches of REGEXPS and accordingly to METRICS. METRICS is list of
@@ -1315,6 +1324,45 @@ score, the more relevant OBJ is to REGEXPS."
zero means that PACKAGE does not match any of REGEXPS."
(relevance package regexps %package-metrics))
+(define* (display-search-results matches port
+ #:key
+ (command "guix search")
+ (print package->recutils))
+ "Display MATCHES, a list of object/score pairs, by calling PRINT on each of
+them. If PORT is a terminal, print at most a full screen of results."
+ (define first-line
+ (port-line port))
+
+ (define max-rows
+ (and first-line (isatty? port)
+ (terminal-rows port)))
+
+ (define (line-count str)
+ (string-count str #\newline))
+
+ (let loop ((matches matches))
+ (match matches
+ (((package . score) rest ...)
+ (let ((text (call-with-output-string
+ (lambda (port)
+ (print package port
+ #:extra-fields
+ `((relevance . ,score)))))))
+ (if (and max-rows
+ (> (port-line port) first-line) ;print at least one result
+ (> (+ 4 (line-count text) (port-line port))
+ max-rows))
+ (unless (null? rest)
+ (display-hint (format #f (G_ "Run @code{~a ... | less} \
+to view all the results.")
+ command)))
+ (begin
+ (display text port)
+ (loop rest)))))
+ (()
+ #t))))
+
+\f
(define (string->generations str)
"Return the list of generations matching a pattern in STR. This function
accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."
--
2.22.0
^ permalink raw reply related [flat|nested] 6+ messages in thread
* [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display
2019-06-26 8:43 [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
@ 2019-06-26 9:57 ` Ricardo Wurmus
2019-06-27 9:19 ` bug#36390: " Ludovic Courtès
1 sibling, 1 reply; 6+ messages in thread
From: Ricardo Wurmus @ 2019-06-26 9:57 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 36390
Ludovic Courtès <ludo@gnu.org> writes:
> This improves ‘guix search’ in two ways:
>
> 1. The relevance score now excludes things that do not match *all*
> the regexps. So ‘guix search go game’ returns 28 results instead
> of 1,245 and the first one is ‘gnugo’; ‘guix search ssh client’
> returns 14 results instead of 510; ‘guix search guile crypto’
> returns just ‘guile-gcrypt’ instead of 279 results.
>
> 2. ‘guix search’ and ‘guix system search’ now write at most a full
> screen of results. You can pipe through a pager to view all the
> results.
Perfect, thank you for the patches!
(I wonder why you chose to use “(cut > <> 0)” instead of “positive?” for
checking if a value is greater than zero.)
--
Ricardo
^ permalink raw reply [flat|nested] 6+ messages in thread
* bug#36390: [PATCH 0/3] Improve 'guix search' relevance and display
2019-06-26 9:57 ` [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ricardo Wurmus
@ 2019-06-27 9:19 ` Ludovic Courtès
0 siblings, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2019-06-27 9:19 UTC (permalink / raw)
To: Ricardo Wurmus; +Cc: 36390-done
Hello!
Ricardo Wurmus <rekado@elephly.net> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> This improves ‘guix search’ in two ways:
>>
>> 1. The relevance score now excludes things that do not match *all*
>> the regexps. So ‘guix search go game’ returns 28 results instead
>> of 1,245 and the first one is ‘gnugo’; ‘guix search ssh client’
>> returns 14 results instead of 510; ‘guix search guile crypto’
>> returns just ‘guile-gcrypt’ instead of 279 results.
>>
>> 2. ‘guix search’ and ‘guix system search’ now write at most a full
>> screen of results. You can pipe through a pager to view all the
>> results.
>
> Perfect, thank you for the patches!
It seems rather non-controversial. :-)
Pushed:
4311cf965c ui: Add 'display-search-results' and use it.
4593f5a654 syscalls: Add 'terminal-rows'.
8874faaaac ui: 'relevance' considers regexps connected with a logical and.
> (I wonder why you chose to use “(cut > <> 0)” instead of “positive?” for
> checking if a value is greater than zero.)
Actually no good reasons, I wanted to amend it and then forgot.
Thanks,
Ludo’.
^ permalink raw reply [flat|nested] 6+ messages in thread
end of thread, other threads:[~2019-06-27 9:20 UTC | newest]
Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2019-06-26 8:43 [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 2/3] syscalls: Add 'terminal-rows' Ludovic Courtès
2019-06-26 8:59 ` [bug#36390] [PATCH 3/3] ui: Add 'display-search-results' and use it Ludovic Courtès
2019-06-26 9:57 ` [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Ricardo Wurmus
2019-06-27 9:19 ` bug#36390: " Ludovic Courtès
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).