gnu: Use Xapian index for package search.series-3104

* gnu/packages.scm (search-package-index): New function.
* guix/ui.scm (display-package-search-results): New function.
* guix/scripts/package.scm (process-query): Search using the Xapian package
index if current profile is available. Else, search using regexps.

3 files changed, 61 insertions, 3 deletions

diff --git a/gnu/packages.scm b/gnu/packages.scm
index c8e221de68..3cbd7c63e3 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -67,7 +67,8 @@
             specifications->manifest
 
             generate-package-cache
-            generate-package-search-index))
+            generate-package-search-index
+            search-package-index))
 
 ;;; Commentary:
 ;;;
@@ -466,6 +467,25 @@ reducing the memory footprint."
 
   db-path)
 
+(define (search-package-index profile query-string)
+  "Search Xapian index in PROFILE for packages matching the Xapian query
+QUERY-STRING.  Return a list of search result texts each corresponding to one
+matching package."
+  (call-with-database (string-append profile %package-search-index)
+    (lambda (db)
+      (let ((query (parse-query query-string #:stemmer (make-stem "en"))))
+        (mset-fold (lambda (item result)
+                     (let ((search-result-text
+                            (call-with-output-string
+                              (cut format <> "~a~%relevance: ~a~%~%"
+                                   (document-data (mset-item-document item))
+                                   ;; Round score to one decimal place.
+                                   (/ (round (* 10 (mset-item-weight item))) 10)))))
+                       (append result (list search-result-text))))
+                   '()
+                   (enquire-mset (enquire db query)
+                                 #:maximum-items (database-document-count db)))))))
+
 
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d2f4f1ccd3..91c975b168 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.
 ;;;
@@ -781,9 +782,11 @@ processed, #f otherwise."
                                       (_                   #f))
                                     opts))
               (regexps  (map (cut make-regexp* <> regexp/icase) patterns))
-              (matches  (find-packages-by-description regexps)))
+              (matches  (if (current-profile)
+                            (search-package-index (current-profile) (string-join patterns " "))
+                            (find-packages-by-description 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 3bc82111a5..163042054c 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -121,6 +121,7 @@
             relevance
             package-relevance
             display-search-results
+            display-package-search-results
             %package-metrics
 
             with-profile-lock
@@ -1490,6 +1491,40 @@ to view all the results.")
       (()
        #t))))
 
+(define* (display-package-search-results search-results port
+                                         #:key
+                                         (command "guix search"))
+  "Display SEARCH-RESULTS, a list of search result texts each corresponding to
+one matching package.  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 ((search-results search-results))
+    (match search-results
+      ((text rest ...)
+       (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 (string->generations str)
   "Return the list of generations matching a pattern in STR.  This function