Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Wed, 26 Jun 2019 08:44:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludo <at> gnu.org>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 36390 in the body.
You can then email your comments to 36390 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#36390; Package guix-patches.
(Wed, 26 Jun 2019 08:44:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Wed, 26 Jun 2019 08:44:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 0/3] Improve 'guix search' relevance and display Date: Wed, 26 Jun 2019 10:43:38 +0200
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
guix-patches <at> gnu.org:bug#36390; Package guix-patches.
(Wed, 26 Jun 2019 09:00:02 GMT) Full text and rfc822 format available.Message #8 received at 36390 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 36390 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/3] ui: 'relevance' considers regexps connected with a logical and. Date: Wed, 26 Jun 2019 10:59:02 +0200
* 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 <at> gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo <at> 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
guix-patches <at> gnu.org:bug#36390; Package guix-patches.
(Wed, 26 Jun 2019 09:00:03 GMT) Full text and rfc822 format available.Message #11 received at 36390 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 36390 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/3] syscalls: Add 'terminal-rows'. Date: Wed, 26 Jun 2019 10:59:03 +0200
* 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)))
+
;;;
;;; 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 <at> gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2015 David Thompson <davet <at> 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
guix-patches <at> gnu.org:bug#36390; Package guix-patches.
(Wed, 26 Jun 2019 09:00:04 GMT) Full text and rfc822 format available.Message #14 received at 36390 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 36390 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/3] ui: Add 'display-search-results' and use it. Date: Wed, 26 Jun 2019 10:59:04 +0200
* 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 <at> gnu.org>
+;;; Copyright © 2017, 2018, 2019 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement <at> 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))))))))))
(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))
+
+;;;
+;;; 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))))
+
+
(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
guix-patches <at> gnu.org:bug#36390; Package guix-patches.
(Wed, 26 Jun 2019 09:58:01 GMT) Full text and rfc822 format available.Message #17 received at 36390 <at> debbugs.gnu.org (full text, mbox):
From: Ricardo Wurmus <rekado <at> elephly.net> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 36390 <at> debbugs.gnu.org Subject: Re: [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Date: Wed, 26 Jun 2019 11:57:05 +0200
Ludovic Courtès <ludo <at> 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
Ludovic Courtès <ludo <at> gnu.org>:Ludovic Courtès <ludo <at> gnu.org>:Message #22 received at 36390-done <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: Ricardo Wurmus <rekado <at> elephly.net> Cc: 36390-done <at> debbugs.gnu.org Subject: Re: [bug#36390] [PATCH 0/3] Improve 'guix search' relevance and display Date: Thu, 27 Jun 2019 11:19:20 +0200
Hello! Ricardo Wurmus <rekado <at> elephly.net> skribis: > Ludovic Courtès <ludo <at> 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’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Thu, 25 Jul 2019 11:24:12 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.