[bug#39258] [PATCH v3 2/3] guix: Search package metadata cache.

[Arun Isaac <arunisaac@systemreboot.net>]

* gnu/packages.scm (search-packages): New function.
* guix/packages.scm (<package-metadata>): New record type.
---
 gnu/packages.scm  | 38 ++++++++++++++++++++++++++++++++++++++
 guix/packages.scm | 32 ++++++++++++++++++++++++++++++++
 2 files changed, 70 insertions(+)

diff --git a/gnu/packages.scm b/gnu/packages.scm
index c0b527acf0..2510b1fe49 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -59,6 +59,7 @@
             find-packages-by-name
             find-package-locations
             find-best-packages-by-name
+            search-packages
 
             specification->package
             specification->package+output
@@ -474,6 +475,43 @@ package modules."
                                #:opts '(#:to-file? #t)))))
   cache-file)
 
+(define (search-packages profile regexps)
+  "Return a list of pairs: <package-metadata> objects corresponding to
+packages whose name, synopsis, description, or output matches at least one of
+REGEXPS sorted by relevance, and its non-zero relevance score."
+  (define cache-file
+    (string-append profile %package-metadata-cache-file))
+
+  (define cache
+    (catch 'system-error
+      (lambda ()
+        (map (match-lambda
+               (#(name version dependencies outputs systems
+                  synopsis description home-page (file line column))
+                (make-package-metadata
+                 name version dependencies outputs systems
+                 synopsis description home-page
+                 (location file line column))))
+             (load-compiled cache-file)))
+      (lambda args
+        (if (= ENOENT (system-error-errno args))
+            #f
+            (apply throw args)))))
+
+  (let ((matches
+         (filter-map (lambda (package-metadata)
+                       (let ((score (package-relevance package-metadata regexps)))
+                         (and (positive? score)
+                              (cons package-metadata score))))
+                     cache)))
+    (sort matches
+          (lambda (m1 m2)
+            (match m1
+              ((package1 . score1)
+               (match m2
+                 ((package2 . score2)
+                  (> score1 score2)))))))))
+
 \f
 (define %sigint-prompt
   ;; The prompt to jump to upon SIGINT.
diff --git a/guix/packages.scm b/guix/packages.scm
index 70b1478c91..bb06baa1ee 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017, 2019 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
+;;; Copyright © 2020 Arun Isaac <arunisaac@systemreboot.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -115,6 +116,21 @@
 
             transitive-input-references
 
+            package-metadata
+            make-package-metadata
+            package-metadata?
+            this-package-metadata
+            package-metadata-name
+            package-metadata-version
+            package-metadata-dependencies
+            package-metadata-outputs
+            package-metadata-synopsis
+            package-metadata-description
+            package-metadata-license
+            package-metadata-home-page
+            package-metadata-supported-systems
+            package-metadata-location
+
             %supported-systems
             %hurd-systems
             %hydra-supported-systems
@@ -310,6 +326,22 @@ name of its URI."
                                                        package)
                                                       16)))))
 
+(define-record-type* <package-metadata>
+  package-metadata make-package-metadata
+  package-metadata?
+  this-package-metadata
+  (name package-metadata-name)
+  (version package-metadata-version)
+  (dependencies package-metadata-dependencies)
+  (outputs package-metadata-outputs)
+  (supported-systems package-metadata-supported-systems)
+  (synopsis package-metadata-synopsis)
+  (description package-metadata-description)
+  ;; TODO: Add license
+  ;; (license package-metadata-license)
+  (home-page package-metadata-home-page)
+  (location package-metadata-location))
+
 (define (package-upstream-name package)
   "Return the upstream name of PACKAGE, which could be different from the name
 it has in Guix."
-- 
2.25.1