@@ -4,6 +4,7 @@
;;; Copyright © 2014 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016, 2017 Alex Kost <alezost@gmail.com>
;;; Copyright © 2016 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -52,7 +53,9 @@
%default-package-module-path
fold-packages
+ fold-packages*
fold-available-packages
+ find-packages-by-name*/direct
find-newest-available-packages
find-packages-by-name
@@ -250,6 +253,23 @@ is guaranteed to never traverse the same package twice."
init
modules))
+(define* (fold-packages* proc init
+ #:optional
+ (modules (all-modules (%package-module-path)
+ #:warn
+ warn-about-load-error))
+ #:key (select? (negate hidden-package?)))
+ "Call (PROC PACKAGE RESULT) for each available package defined in one of
+MODULES that matches SELECT?, using INIT as the initial value of RESULT. It
+is guaranteed to never traverse the same package twice."
+ (fold-module-public-variables* (lambda (module symbol var result)
+ (let ((object (variable-ref var)))
+ (if (and (package? object) (select? object))
+ (proc module symbol object result)
+ result)))
+ init
+ modules))
+
(define %package-cache-file
;; Location of the package cache.
"/lib/guix/package.cache")
@@ -297,6 +317,27 @@ decreasing version order."
matching)
matching)))))
+(define find-packages-by-name*/direct ;bypass the cache
+ (let ((packages (delay
+ (fold-packages* (lambda (mod sym p r)
+ (vhash-cons (package-name p) (list mod sym p) r))
+ vlist-null)))
+ (version>? (match-lambda*
+ (((_ _ versions) ..1)
+ (apply version>? (map package-version versions))))))
+ (lambda* (name #:optional version)
+ "Return the list of (<module> <symbol> <package>) with the given NAME. If
+ VERSION is not #f, then only return packages whose version is prefixed by
+ VERSION, sorted in decreasing version order."
+ (let ((matching (sort (vhash-fold* cons '() name (force packages))
+ version>?)))
+ (if version
+ (filter (match-lambda
+ ((_ _ package)
+ (version-prefix? version (package-version package))))
+ matching)
+ matching)))))
+
(define (cache-lookup cache name)
"Lookup package NAME in CACHE. Return a list sorted in increasing version
order."
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Martin Becze <mjbecze@riseup.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1135,11 +1136,23 @@
(((? (cut eq? hello <>))) #t)
(wrong (pk 'find-packages-by-name wrong #f))))
+(test-assert "find-packages-by-name*/direct"
+ (match (find-packages-by-name*/direct "hello")
+ ((((? (cut eq? (resolve-interface '(gnu packages base)) <>))
+ (? (cut eq? 'hello <>))
+ (? (cut eq? hello <>)))) #t)))
+
(test-assert "find-packages-by-name with version"
(match (find-packages-by-name "hello" (package-version hello))
(((? (cut eq? hello <>))) #t)
(wrong (pk 'find-packages-by-name wrong #f))))
+(test-assert "find-packages-by-name*/direct with version"
+ (match (find-packages-by-name*/direct "hello" (package-version hello))
+ ((((? (cut eq? (resolve-interface '(gnu packages base)) <>))
+ (? (cut eq? 'hello <>))
+ (? (cut eq? hello <>)))) #t)))
+
(test-equal "find-packages-by-name with cache"
(find-packages-by-name "guile")
(call-with-temporary-directory