diff mbox series

[bug#49522] weather: Don't look for exported package replacements twice.

Message ID 20210711115638.30207-1-mail@cbaines.net
State New
Headers show
Series [bug#49522] weather: Don't look for exported package replacements twice. | expand

Checks

Context Check Description
cbaines/comparison success View comparision
cbaines/git branch success View Git branch
cbaines/applying patch success View Laminar job
cbaines/issue success View issue

Commit Message

Christopher Baines July 11, 2021, 11:56 a.m. UTC
There could be performance issues with member here, but only if there are lots
of replacements.

* guix/scripts/weather.scm (all-packages): Return all exported packages, plus
non exported replacements, rather than including exported replacements twice.
---
 guix/scripts/weather.scm | 35 ++++++++++++++++++++++++-----------
 1 file changed, 24 insertions(+), 11 deletions(-)
diff mbox series

Patch

diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index 06312d65a2..0f70dc8460 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -53,17 +53,30 @@ 
   #:export (guix-weather))
 
 (define (all-packages)
-  "Return the list of public packages we are going to query."
-  (fold-packages (lambda (package result)
-                   (match (package-replacement package)
-                     ((? package? replacement)
-                      (cons* replacement package result))
-                     (#f
-                      (cons package result))))
-                 '()
-
-                 ;; Dismiss deprecated packages but keep hidden packages.
-                 #:select? (negate package-superseded)))
+  "Return the list of packages we are going to query."
+  (let* ((packages
+          (fold-packages (lambda (package result)
+                           (cons package result))
+                         '()
+
+                         ;; Dismiss deprecated packages but keep hidden packages.
+                         #:select? (negate package-superseded)))
+         (non-exported-replacement-packages
+          (fold-packages (lambda (package result)
+                           (let ((replacement (package-replacement package)))
+                             (if (and replacement
+                                      ;; Avoid double couting replacements
+                                      ;; that are themselves exported
+                                      (not (member replacement packages)))
+                                 (cons replacement result)
+                                 result)))
+                         '()
+
+                         ;; Dismiss deprecated packages but keep hidden packages.
+                         #:select? (negate package-superseded))))
+    (append
+     packages
+     non-exported-replacement-packages)))
 
 (define (call-with-progress-reporter reporter proc)
   "This is a variant of 'call-with-progress-reporter' that works with monadic