nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ui: Add 'display-search-results' and use it. 

* 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'.
This commit is contained in:
Ludovic Courtès 2019-06-25 23:37:32 +02:00
parent 4593f5a654
commit 4311cf965c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 86 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
guix/scripts/package.scm
View File

@ -26,6 +26,7 @@
(define-module (guix scripts package) (define-module (guix scripts package)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((guix status) #:select (with-status-verbosity)) #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module ((guix build syscalls) #:select (terminal-rows))
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix grafts) #:use-module (guix grafts)
#:use-module (guix derivations) #:use-module (guix derivations)
@ -178,9 +179,9 @@ hooks\" run when building the profile."
;;; ;;;
(define (find-packages-by-description regexps) (define (find-packages-by-description regexps)
"Return two values: the list of packages whose name, synopsis, description, "Return a list of pairs: packages whose name, synopsis, description,
or output matches at least one of REGEXPS sorted by relevance, and the list of or output matches at least one of REGEXPS sorted by relevance, and its
relevance scores." non-zero relevance score."
(let ((matches (fold-packages (lambda (package result) (let ((matches (fold-packages (lambda (package result)
(if (package-superseded package) (if (package-superseded package)
result result
@ -189,19 +190,19 @@ relevance scores."
((? zero?) ((? zero?)
result) result)
(score (score
(cons (list package score) (cons (cons package score)
result))))) result)))))
'()))) '())))
(unzip2 (sort matches (sort matches
(lambda (m1 m2) (lambda (m1 m2)
(match m1 (match m1
((package1 score1) ((package1 . score1)
(match m2 (match m2
((package2 score2) ((package2 . score2)
(if (= score1 score2) (if (= score1 score2)
(string>? (package-full-name package1) (string>? (package-full-name package1)
(package-full-name package2)) (package-full-name package2))
(> score1 score2))))))))))) (> score1 score2))))))))))
(define (transaction-upgrade-entry entry transaction) (define (transaction-upgrade-entry entry transaction)
"Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a "Return a variant of TRANSACTION that accounts for the upgrade of ENTRY, a
@ -755,16 +756,10 @@ processed, #f otherwise."
(('query 'search rx) rx) (('query 'search rx) rx)
(_ #f)) (_ #f))
opts)) 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 (leave-on-EPIPE
(let-values (((packages scores) (display-search-results matches (current-output-port)))
(find-packages-by-description regexps)))
(for-each (lambda (package score)
(package->recutils package (current-output-port)
#:extra-fields
`((relevance . ,score))))
packages
scores)))
#t)) #t))
(('show requested-name) (('show requested-name)

44
guix/scripts/system/search.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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> ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
@ -139,9 +139,8 @@ columns."
. 1))) . 1)))
(define (find-service-types regexps) (define (find-service-types regexps)
"Return two values: the list of service types whose name or description "Return a list of service type/score pairs: service types whose name or
matches at least one of REGEXPS sorted by relevance, and the list of relevance description matches REGEXPS sorted by relevance, and their score."
scores."
(let ((matches (fold-service-types (let ((matches (fold-service-types
(lambda (type result) (lambda (type result)
(match (relevance type regexps (match (relevance type regexps
@ -149,30 +148,25 @@ scores."
((? zero?) ((? zero?)
result) result)
(score (score
(cons (list type score) result)))) (cons (cons type score) result))))
'()))) '())))
(unzip2 (sort matches (sort matches
(lambda (m1 m2) (lambda (m1 m2)
(match m1 (match m1
((type1 score1) ((type1 . score1)
(match m2 (match m2
((type2 score2) ((type2 . score2)
(if (= score1 score2) (if (= score1 score2)
(string>? (service-type-name* type1) (string>? (service-type-name* type1)
(service-type-name* type2)) (service-type-name* type2))
(> score1 score2))))))))))) (> score1 score2))))))))))
(define (guix-system-search . args) (define (guix-system-search . args)
(with-error-handling (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 (leave-on-EPIPE
(let-values (((services scores) (display-search-results matches (current-output-port)
(find-service-types regexps))) #:print service-type->recutils
(for-each (lambda (service score) #:command "guix system search")))))
(service-type->recutils service
(current-output-port)
#:extra-fields
`((relevance . ,score))))
services
scores))))))

50
guix/ui.scm
View File

@ -46,7 +46,8 @@
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module ((guix licenses) #:select (license? license-name)) #:use-module ((guix licenses) #:select (license? license-name))
#:use-module ((guix build syscalls) #:use-module ((guix build syscalls)
#:select (free-disk-space terminal-columns)) #:select (free-disk-space terminal-columns
terminal-rows))
#:use-module ((guix build utils) #:use-module ((guix build utils)
;; XXX: All we need are the bindings related to ;; XXX: All we need are the bindings related to
;; '&invoke-error'. However, to work around the bug described ;; '&invoke-error'. However, to work around the bug described
@ -106,8 +107,11 @@
string->recutils string->recutils
package->recutils package->recutils
package-specification->name+version+output package-specification->name+version+output
relevance relevance
package-relevance package-relevance
display-search-results
string->generations string->generations
string->duration string->duration
matching-generations matching-generations
@ -1246,6 +1250,11 @@ WIDTH columns. EXTRA-FIELDS is a list of symbol/value pairs to emit."
extra-fields) extra-fields)
(newline port)) (newline port))
;;;
;;; Searching.
;;;
(define (relevance obj regexps metrics) (define (relevance obj regexps metrics)
"Compute a \"relevance score\" for OBJ as a function of its number of "Compute a \"relevance score\" for OBJ as a function of its number of
matches of REGEXPS and accordingly to METRICS. METRICS is list 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." zero means that PACKAGE does not match any of REGEXPS."
(relevance package regexps %package-metrics)) (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) (define (string->generations str)
"Return the list of generations matching a pattern in STR. This function "Return the list of generations matching a pattern in STR. This function
accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"." accepts the following patterns: \"1\", \"1,2,3\", \"1..9\", \"1..\", \"..9\"."