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)
#: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)

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

@ -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))))))))))
(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")))))

50
guix/ui.scm
View File

@ -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\"."