import: gnome: Allow updating to a specific version.

* guix/import/gnome.scm (latest-gnome-release): Rename
  to 'import-gnome-release', add #:version argument. If version is
  given, try to find the respective version
  [find-latest-release]: New function, based on former code.
  [find-version-release]: New function.

1 files changed, 30 insertions, 17 deletions

diff --git a/guix/import/gnome.scm b/guix/import/gnome.scm
index 09c6dbbd0d..3c5a96fdde 100644
--- a/guix/import/gnome.scm
+++ b/guix/import/gnome.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017, 2019, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,9 +58,10 @@ 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."
+not be determined. Optionally include a VERSION string to fetch a specific
+version."
   (define %not-dot
     (char-set-complement (char-set #\.)))
 
@@ -88,6 +90,28 @@ https://discourse.gnome.org/t/new-gnome-versioning-scheme/4235"
     ;; Some packages like "NetworkManager" have camel-case names.
     (package-upstream-name package))
 
+  (define (find-latest-release releases)
+    (fold (match-lambda*
+           (((key . value) result)
+            (cond ((release-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)
+    (find (match-lambda
+            ((key . value)
+             (string=? key version)))
+          releases))
+
   (guard (c ((http-get-error? c)
              (if (= 404 (http-get-error-code c))
                  #f
@@ -108,20 +132,9 @@ https://discourse.gnome.org/t/new-gnome-versioning-scheme/4235"
       (match json
         (#(4 releases _ ...)
          (let* ((releases (assoc-ref releases upstream-name))
-                (latest   (fold (match-lambda*
-                                  (((key . value) result)
-                                   (cond ((release-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))))))))
 
@@ -130,4 +143,4 @@ https://discourse.gnome.org/t/new-gnome-versioning-scheme/4235"
    (name 'gnome)
    (description "Updater for GNOME packages")
    (pred (url-prefix-predicate "mirror://gnome/"))
-   (import latest-gnome-release)))
+   (import import-gnome-release)))