diff mbox series

[bug#38408,v4,1/6] gnu: added new function, find-packages-by-name*/direct

Message ID d83466c676763462ce625fe04df176c7681fc836.1576005195.git.mjbecze@riseup.net
State Accepted
Headers show
Series Semantic version aware recusive importer for crates | expand

Commit Message

Martin Becze Dec. 10, 2019, 7:23 p.m. UTC 
* gnu/packages.scm (find-packages-by-naem*/direct)
---
 gnu/packages.scm   | 41 +++++++++++++++++++++++++++++++++++++++++
 tests/packages.scm | 13 +++++++++++++
 2 files changed, 54 insertions(+)

Comments

Ludovic Courtès Dec. 19, 2019, 10 p.m. UTC | #1 
Hello!

I’m not a Crate expert so I’m only commenting on non-Crate-specific
bits.

Martin Becze <mjbecze@riseup.net> skribis:

> * gnu/packages.scm (find-packages-by-naem*/direct)

[...]

> +(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)

I’m wary of exposing variable names, especially in such a central API.

> +(define find-packages-by-name*/direct              ;bypass the cache

Providing an explicit cache bypassing method also sounds worrying to me:
the cache is supposed to be transparent and semantics-preserving.

More generally, I think adding new features to an importer shouldn’t
require modifications in this area, as a matter of separating concerns.

WDYT?

Thanks,
Ludo’.
diff mbox series

Patch

diff --git a/gnu/packages.scm b/gnu/packages.scm
index 959777ff8f..cca2a393e5 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -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."
diff --git a/tests/packages.scm b/tests/packages.scm
index 423c5061aa..9f02b0d5d2 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -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