[bug#39258] [PATCH v3 3/3] guix: Use package metadata cache for package search.

[Arun Isaac <arunisaac@systemreboot.net>]

* guix/scripts/package.scm (process-query): Call search-packages and
display-package-search-results instead of find-packages-by-description and
display-search-results respectively.
* guix/ui.scm (package-metadata->recutils): New function.
(%package-metrics): Use package-metadata record field accessors.
(package-relevance): Rename argument package to package-metadata.
(display-package-search-results): New function.
---
 guix/scripts/package.scm |   5 +-
 guix/ui.scm              | 132 ++++++++++++++++++++++++++++++++++++---
 2 files changed, 125 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 110d4f2977..c11f92f5a2 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 Benz Schenk <benz.schenk@uzh.ch>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -770,9 +771,9 @@ processed, #f otherwise."
                                       (_                   #f))
                                     opts))
               (regexps  (map (cut make-regexp* <> regexp/icase) patterns))
-              (matches  (find-packages-by-description regexps)))
+              (matches  (search-packages (current-profile) regexps)))
          (leave-on-EPIPE
-          (display-search-results matches (current-output-port)))
+          (display-package-search-results matches (current-output-port)))
          #t))
 
       (('show requested-name)
diff --git a/guix/ui.scm b/guix/ui.scm
index 1e24fe5dca..934699f065 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -14,6 +14,7 @@
 ;;; Copyright © 2019 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2019 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -112,6 +113,7 @@
             package-synopsis-string
             string->recutils
             package->recutils
+            package-metadata->recutils
             package-specification->name+version+output
 
             supports-hyperlinks?
@@ -122,6 +124,7 @@
             relevance
             package-relevance
             display-search-results
+            display-package-search-results
 
             with-profile-lock
             string->generations
@@ -1484,6 +1487,75 @@ HYPERLINKS? is true, emit hyperlink escape sequences when appropriate."
             extra-fields)
   (newline port))
 
+(define* (package-metadata->recutils p port #:optional (width (%text-width))
+                                     #:key
+                                     (hyperlinks? (supports-hyperlinks? port))
+                                     (extra-fields '()))
+  "Write to PORT a `recutils' record of <package-metadata> object P, arranging
+to fit within WIDTH columns.  EXTRA-FIELDS is a list of symbol/value pairs to
+emit.  When HYPERLINKS? is true, emit hyperlink escape sequences when
+appropriate."
+  (define width*
+    ;; The available number of columns once we've taken into account space for
+    ;; the initial "+ " prefix.
+    (if (> width 2) (- width 2) width))
+
+  ;; Note: Don't i18n field names so that people can post-process it.
+  (format port "name: ~a~%" (package-metadata-name p))
+  (format port "version: ~a~%" (package-metadata-version p))
+  (format port "outputs: ~a~%" (string-join (package-metadata-outputs p)))
+  (format port "systems: ~a~%"
+          (string-join (package-metadata-supported-systems p)))
+  (format port "dependencies: ~a~%"
+          (string-join (package-metadata-dependencies p) " "))
+  (format port "location: ~a~%"
+          (or (and=> (package-metadata-location p)
+                     (if hyperlinks? location->hyperlink location->string))
+              (G_ "unknown")))
+
+  ;; Note: Starting from version 1.6 or recutils, hyphens are not allowed in
+  ;; field identifiers.
+  (format port "homepage: ~a~%" (package-metadata-home-page p))
+
+  ;; TODO: Print license
+  ;; (format port "license: ~a~%"
+  ;;         (match (package-metadata-license p)
+  ;;           (((? license? licenses) ...)
+  ;;            (string-join (map license-name licenses)
+  ;;                         ", "))
+  ;;           ((? license? license)
+  ;;            (let ((text (license-name license))
+  ;;                  (uri  (license-uri license)))
+  ;;              (if (and hyperlinks? uri (string-prefix? "http" uri))
+  ;;                  (hyperlink uri text)
+  ;;                  text)))
+  ;;           (x
+  ;;            (G_ "unknown"))))
+  (format port "synopsis: ~a~%"
+          (string-map (match-lambda
+                        (#\newline #\space)
+                        (chr       chr))
+                      (or (and=> (package-metadata-synopsis p) P_)
+                          "")))
+  (format port "~a~%"
+          (string->recutils
+           (string-trim-right
+            (parameterize ((%text-width width*))
+              (texi->plain-text
+               (string-append "description: "
+                              (or (and=> (package-metadata-description p) P_)
+                                  ""))))
+            #\newline)))
+  (for-each (match-lambda
+              ((field . value)
+               (let ((field (symbol->string field)))
+                 (format port "~a: ~a~%"
+                         field
+                         (fill-paragraph (object->string value) width*
+                                         (string-length field))))))
+            extra-fields)
+  (newline port))
+
 \f
 ;;;
 ;;; Searching.
@@ -1528,34 +1600,74 @@ score, the more relevant OBJ is to REGEXPS."
 (define %package-metrics
   ;; Metrics used to compute the "relevance score" of a package against a set
   ;; of regexps.
-  `((,package-name . 4)
+  `((,package-metadata-name . 4)
 
     ;; Match against uncommon outputs.
-    (,(lambda (package)
+    (,(lambda (package-metadata)
         (filter (lambda (output)
                   (not (member output
                                ;; Some common outpus shared by many packages.
                                '("out" "doc" "debug" "lib" "include" "bin"))))
-                (package-outputs package)))
+                (package-metadata-outputs package-metadata)))
      . 1)
 
     ;; Match regexps on the raw Texinfo since formatting it is quite expensive
     ;; and doesn't have much of an effect on search results.
-    (,(lambda (package)
-        (and=> (package-synopsis package) P_)) . 3)
-    (,(lambda (package)
-        (and=> (package-description package) P_)) . 2)
+    (,(lambda (package-metadata)
+        (and=> (package-metadata-synopsis package-metadata) P_)) . 3)
+    (,(lambda (package-metadata)
+        (and=> (package-metadata-description package-metadata) P_)) . 2)
 
     (,(lambda (type)
-        (match (and=> (package-location type) location-file)
+        (match (and=> (package-metadata-location type) location-file)
           ((? string? file) (basename file ".scm"))
           (#f "")))
      . 1)))
 
-(define (package-relevance package regexps)
+(define (package-relevance package-metadata regexps)
   "Return a score denoting the relevance of PACKAGE for REGEXPS.  A score of
 zero means that PACKAGE does not match any of REGEXPS."
-  (relevance package regexps %package-metrics))
+  (relevance package-metadata regexps %package-metrics))
+
+(define* (display-package-search-results matches port
+                                 #:key
+                                 (command "guix search"))
+  "Display MATCHES, a list of <package-metadata>/score pairs.  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-metadata . score) rest ...)
+       (let* ((links? (supports-hyperlinks? port))
+              (text   (call-with-output-string
+                        (lambda (port)
+                          (package-metadata->recutils package-metadata port
+                                                      #:hyperlinks? links?
+                                                      #:extra-fields
+                                                      `((relevance . ,score)))))))
+         (if (and (not (getenv "INSIDE_EMACS"))
+                  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* (display-search-results matches port
                                  #:key
-- 
2.25.1