[bug#57460] [PATCH 10/20] refresh: Allow updating to a specific version (gnome)

[Hartmut Goebel]

* guix/import/gnome.scm(latest-gnome-release): Rename
  to (import-gnome-release), add keyword-argument 'version'. If version is
  given, try to find the respective version
  [find-latest-release]: New function, based on former code.
  [find-version-release]: New function.
---
 guix/import/gnome.scm | 47 ++++++++++++++++++++++++++++---------------
 1 file changed, 31 insertions(+), 16 deletions(-)

diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 3562e17e0f..496c253969 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* (import-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))))))))
 
@@ -114,4 +129,4 @@ not be determined."
    (name 'gnome)
    (description "Updater for GNOME packages")
    (pred (url-prefix-predicate "mirror://gnome/"))
-   (import latest-gnome-release)))
+   (import import-gnome-release)))
-- 
2.30.4