Subject: [bug#39258] [PATCH v6 2/2] DRAFT scripts: package: Use cache in 'find-packages-by-description'.

From: zimoun <[email-masked]>
Date: Thu, 15 Jul 2021 09:33:28 +0200

* guix/scripts/package.scm (find-packages-by-description): Replace
'fold-packages' by 'fold-available-packages'.
---
 guix/scripts/package.scm | 46 +++++++++++++++++++++++++++++-----------
 1 file changed, 34 insertions(+), 12 deletions(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 694959d326..ff2aed6905 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -8,7 +8,7 @@
 ;;; Copyright © 2016 Chris Marusich <[email-masked]>
 ;;; Copyright © 2019 Tobias Geerinckx-Rice <[email-masked]>
 ;;; Copyright © 2020 Ricardo Wurmus <[email-masked]>
-;;; Copyright © 2020 Simon Tournier <[email-masked]>
+;;; Copyright © 2020, 2021 Simon Tournier <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -181,17 +181,39 @@ hooks\" run when building the profile."
   "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
-                                      (match (package-relevance package
-                                                                regexps)
-                                        ((? zero?)
-                                         result)
-                                        (score
-                                         (cons (cons package score)
-                                               result)))))
-                                '())))
+  (define (read-package-from module symbol)
+    (module-ref (resolve-interface module) symbol))
+
+  (let ((matches (fold-available-packages
+                  (lambda* (name version result
+                                 #:key outputs description synopsis location
+                                 module symbol
+                                 deprecated?
+                                 #:allow-other-keys)
+                    (if deprecated?
+                        result
+                        (let* ((package
+                                 (package
+                                   (name name)
+                                   (version version)
+                                   (source #f)
+                                   (build-system #f)
+                                   (outputs outputs)
+                                   (synopsis synopsis)
+                                   (description description)
+                                   (home-page #f)
+                                   (license #f)
+                                   (location location))))
+                          (match (package-relevance package
+                                                    regexps)
+                            ((? zero?)
+                             result)
+                            (score
+                             (cons (cons (read-package-from module symbol)
+                                         score)
+                                   result))))))
+                  '())))
+
     (sort matches
           (lambda (m1 m2)
             (match m1
-- 
2.32.0