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'.

2 files changed, 37 insertions, 48 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))))))))))
 
 
 (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")))))