summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac <arunisaac@systemreboot.net>2020-03-27 21:56:53 +0530
committerGuix Patches Tester <>2020-03-27 16:29:06 +0000
commitbf4676539f333b2996bd11d82942471ec95a5f97 (patch)
tree135fc7d4ec50bd0607317075237478d250694c6c
parentff3423f30231c99c9a4bdd45bf6b727873ea1aa7 (diff)
downloadpatches-bf4676539f333b2996bd11d82942471ec95a5f97.tar
patches-bf4676539f333b2996bd11d82942471ec95a5f97.tar.gz
guix: Search package metadata cache.
* gnu/packages.scm (search-packages): New function. * guix/packages.scm (<package-metadata>): New record type.
-rw-r--r--gnu/packages.scm38
-rw-r--r--guix/packages.scm32
2 files changed, 70 insertions, 0 deletions
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)))))))))
+
(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."