18/23: gnome:

[guix-commits]

htgoebel pushed a commit to branch wip-import-version
in repository guix.

commit 2807d9e4ed8dee913dcc25b059167a9c9d0d0fa6
Author: Hartmut Goebel <h.goebel@crazy-compilers.com>
AuthorDate: Wed Jun 29 10:51:12 2022 +0200

    gnome:
    
    * guix/import/gnome.scm(latest-release): kw-arg version, this argument
      overrules the version from projekt-info.
      [find-latest-release]: New function, based on former code.
      [find-version-release]: New function.
---
 guix/import/gnome.scm | 45 ++++++++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 15 deletions(-)

diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 43966c1028..c05291eef6 100644
--- a/guix/import/gnome.scm
+++ b/guix/import/gnome.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -54,7 +55,7 @@ source for metadata."
                                             name "/" relative-url))))
                         '("tar.lz" "tar.xz" "tar.bz2" "tar.gz")))))))
 
-(define (latest-gnome-release package)
+(define* (latest-gnome-release package #:key (version #f))
   "Return the latest release of PACKAGE, a GNOME package, or #f if it could
 not be determined."
   (define %not-dot
@@ -72,6 +73,31 @@ not be determined."
     ;; Some packages like "NetworkManager" have camel-case names.
     (package-upstream-name package))
 
+  (define (find-latest-release releases)
+    (fold (match-lambda*
+           (((key . value) result)
+            (cond ((even-minor-version? key)
+                   (match result
+                          (#f
+                           (cons key value))
+                          ((newest . _)
+                           (if (version>? key newest)
+                               (cons key value)
+                               result))))
+                  (else
+                   result))))
+          #f
+          releases))
+
+  (define (find-version-release releases version)
+    (fold (match-lambda*
+           (((key . value) result)
+            (if (string=? key version)
+                (cons key value)
+                result)))
+          #f
+          releases))
+
   (guard (c ((http-get-error? c)
              (if (= 404 (http-get-error-code c))
                  #f
@@ -92,20 +118,9 @@ not be determined."
       (match json
         (#(4 releases _ ...)
          (let* ((releases (assoc-ref releases upstream-name))
-                (latest   (fold (match-lambda*
-                                  (((key . value) result)
-                                   (cond ((even-minor-version? key)
-                                          (match result
-                                            (#f
-                                             (cons key value))
-                                            ((newest . _)
-                                             (if (version>? key newest)
-                                                 (cons key value)
-                                                 result))))
-                                         (else
-                                          result))))
-                                #f
-                                releases)))
+                (latest (if version
+                            (find-version-release releases version)
+                            (find-latest-release releases))))
            (and latest
                 (jsonish->upstream-source upstream-name latest))))))))