From 4311cf965c978c7865c03349c82110b241f8ff23 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 25 Jun 2019 23:37:32 +0200 Subject: 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'. --- guix/scripts/package.scm | 41 +++++++++++++++++---------------------- guix/scripts/system/search.scm | 44 ++++++++++++++++++------------------------ 2 files changed, 37 insertions(+), 48 deletions(-) (limited to 'guix/scripts') 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 +;;; Copyright © 2017, 2018, 2019 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; ;;; 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"))))) -- cgit v1.2.3