[bug#57460] [PATCH v3 10/18] import: github: Allow updating to a specific version.

[Hartmut Goebel]

* guix/import/github.scm (latest-released-version): Add #:version argument.
  If version is given, try to find the respective release.
  (latest-releease) Rename to 'import-release', add #:version argument
  and pass it on to 'latest-released-version'.
---
 guix/import/github.scm | 36 ++++++++++++++++++++++++------------
 1 file changed, 24 insertions(+), 12 deletions(-)

diff --git a/guix/import/github.scm b/guix/import/github.scm
index ac6ef06eda..a1bda5ec43 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -249,11 +249,13 @@ Alternatively, you can wait until your rate limit is 
reset, or use the
                                            #:headers headers)))
                    (x x)))))))))
 
-(define (latest-released-version url package-name)
+(define* (latest-released-version url package-name #:key (version #f))
   "Return the newest released version and its tag given a string URL like
 'https://github.com/arq5x/bedtools2/archive/v2.24.0.tar.gz' and the name of
 the package e.g. 'bedtools2'.  Return #f (two values) if there are no
-releases."
+releases.
+
+Optionally include a VERSION string to fetch a specific version."
   (define (pre-release? x)
     (assoc-ref x "prerelease"))
 
@@ -290,16 +292,25 @@ releases."
   (match (and=> (fetch-releases-or-tags url) vector->list)
     (#f (values #f #f))
     (json
-     (match (sort (filter-map release->version
-                              (match (remove pre-release? json)
-                                (() json)         ; keep everything
-                                (releases releases)))
-                  (lambda (x y) (version>? (car x) (car y))))
+     (let ((releases (filter-map release->version
+                                 (match (remove pre-release? json)
+                                   (() json)         ; keep everything
+                                   (releases releases)))))
+       (match (if version
+                  ;; Find matching release version.
+                  (filter (match-lambda
+                           ((candidate-version . tag)
+                            (string=? version candidate-version)))
+                          releases)
+                  ;; Sort releases descending.
+                  (sort releases
+                        (lambda (x y) (version>? (car x) (car y)))))
        (((latest-version . tag) . _) (values latest-version tag))
-       (() (values #f #f))))))
+       (() (values #f #f)))))))
 
-(define (latest-release pkg)
-  "Return an <upstream-source> for the latest release of PKG."
+(define* (import-release pkg #:key (version #f))
+  "Return an <upstream-source> for the latest release of PKG.
+Optionally include a VERSION string to fetch a specific version."
   (define (github-uri uri)
     (match uri
       ((? string? url)
@@ -313,7 +324,8 @@ releases."
          (source-uri (github-uri original-uri))
          (name (package-name pkg))
          (newest-version version-tag
-                         (latest-released-version source-uri name)))
+                         (latest-released-version source-uri name
+                                                  #:version version)))
     (if newest-version
         (upstream-source
          (package name)
@@ -330,6 +342,6 @@ releases."
    (name 'github)
    (description "Updater for GitHub packages")
    (pred github-package?)
-   (import latest-release)))
+   (import import-release)))
 
 
-- 
2.30.6