unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Herman Rimm via Guix-patches via <guix-patches@gnu.org>
To: 75496@debbugs.gnu.org
Cc: Divya Ranjan Pattanaik <divya@subvertising.org>,
	Efraim Flashner <efraim@flashner.co.il>
Subject: [bug#75496] [PATCH rust-team 2/2] import: crate: Refactor find-package-version.
Date: Sat, 11 Jan 2025 15:38:48 +0100	[thread overview]
Message-ID: <991ead37c954cea75fff524f1fad2c8d88c8e5bf.1736606198.git.herman@rimm.ee> (raw)
In-Reply-To: <9fab183f6a0ee9be09769e7f776f0b9c615b2c97.1736606198.git.herman@rimm.ee>

* guix/import/crate.scm (crate->guix-package)[find-package-version]:
Move to top-level.
[dependency-name+version+yanked]: Adjust.
(find-package-version): Take allow-yanked? argument.  Use (let) loop,
match, if instead of map, filter, min-element.

Change-Id: I1d05f55a027241e7c5f62cc98a50a09b5639bdcf
---
 guix/import/crate.scm | 55 ++++++++++++++++++++++---------------------
 1 file changed, 28 insertions(+), 27 deletions(-)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index a7134b85722..d790126ef6e 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2023 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2023, 2024 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2023, 2024 David Elsing <david.elsing@posteo.net>
+;;; Copyright © 2025 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -290,6 +291,31 @@ (define (nonyanked-crate-versions crate)
             (not (crate-version-yanked? entry)))
           (crate-versions crate)))
 
+(define (find-package-version name range allow-yanked?)
+  "Find the latest existing package that fulfills the SemVer RANGE.  If
+ALLOW-YANKED? is #t, include packages marked as yanked at a lower
+priority."
+  (set! range (string->semver-range range))
+  (let loop ((packages (find-packages-by-name
+                         (crate-name->package-name name)))
+             (semver #f)
+             (yanked? #f))
+    (match packages
+      ((pkg packages ...)
+       (let ((pkg-yanked? (assoc-ref (package-properties pkg)
+                                    'crate-version-yanked?)))
+         (if (or allow-yanked? (not pkg-yanked?))
+             (let ((pkg-semver (string->semver (package-version pkg))))
+               (if (and (or (not semver)
+                            (and yanked? (not pkg-yanked?))
+                            (and (eq? yanked? pkg-yanked?)
+                                 (semver>? pkg-semver semver)))
+                        (semver-range-contains? range pkg-semver))
+                   (loop packages pkg-semver pkg-yanked?)
+                   (loop packages semver yanked?)))
+             (loop packages semver yanked?))))
+      (() (and semver (list (semver->string semver) yanked?))))))
+
 (define* (crate->guix-package
           crate-name
           #:key version include-dev-deps? allow-yanked? #:allow-other-keys)
@@ -316,32 +342,6 @@ (define* (crate->guix-package
          (or version
              (crate-latest-version crate))))
 
-  ;; Find the highest existing package that fulfills the semver <range>.
-  ;; Packages previously marked as yanked take lower priority.
-  (define (find-package-version name range)
-    (let* ((semver-range (string->semver-range range))
-           (version
-            (min-element
-             (filter (match-lambda ((semver yanked)
-                                    (and
-                                     (or allow-yanked? (not yanked))
-                                     (semver-range-contains? semver-range semver))))
-                     (map (lambda (pkg)
-                            (let ((version (package-version pkg)))
-                              (list
-                                (string->semver version)
-                                (assoc-ref (package-properties pkg)
-                                           'crate-version-yanked?))))
-                          (find-packages-by-name
-                           (crate-name->package-name name))))
-             (match-lambda* (((semver1 yanked1) (semver2 yanked2))
-                             (and (or (not yanked1) yanked2)
-                                  (or (not (eq? yanked1 yanked2))
-                                      (semver>? semver1 semver2))))))))
-      (and (not (eq? #f version))
-           (match-let (((semver yanked) version))
-             (list (semver->string semver) yanked)))))
-
   ;; Find the highest version of a crate that fulfills the semver <range>.
   ;; If no matching non-yanked version has been found and allow-yanked? is #t,
   ;; also consider yanked packages.
@@ -361,7 +361,8 @@ (define* (crate->guix-package
   (define (dependency-name+version+yanked dep)
     (let* ((name (crate-dependency-id dep))
                  (req (crate-dependency-requirement dep))
-                 (existing-version (find-package-version name req)))
+                 (existing-version
+                  (find-package-version name req allow-yanked?)))
       (if (and existing-version (not (second existing-version)))
           (cons name existing-version)
           (let* ((crate (lookup-crate* name))
-- 
2.47.1





  reply	other threads:[~2025-01-11 14:40 UTC|newest]

Thread overview: 4+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2025-01-11 14:37 [bug#75496] [PATCH rust-team 1/2] import: crate: Fix find-package-version Herman Rimm via Guix-patches via
2025-01-11 14:38 ` Herman Rimm via Guix-patches via [this message]
     [not found] ` <handler.75496.B.173660630029755.ack@debbugs.gnu.org>
2025-01-11 15:56   ` [bug#75496] Acknowledgement ([PATCH rust-team 1/2] import: crate: Fix find-package-version.) Herman Rimm via Guix-patches via
2025-01-26  9:08     ` bug#75496: " Efraim Flashner

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://guix.gnu.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=991ead37c954cea75fff524f1fad2c8d88c8e5bf.1736606198.git.herman@rimm.ee \
    --to=guix-patches@gnu.org \
    --cc=75496@debbugs.gnu.org \
    --cc=divya@subvertising.org \
    --cc=efraim@flashner.co.il \
    --cc=herman@rimm.ee \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).