guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

20/23: github REWORD


From: guix-commits
Subject: 20/23: github REWORD
Date: Mon, 4 Jul 2022 09:49:27 -0400 (EDT)

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

commit 2e43663c76e72844c84c1f89692af0839ecb87d3
Author: Hartmut Goebel <h.goebel@crazy-compilers.com>
AuthorDate: Wed Jun 29 14:13:55 2022 +0200

    github REWORD
---
 guix/import/git.scm    |  1 +
 guix/import/github.scm | 25 ++++++++++++++++---------
 2 files changed, 17 insertions(+), 9 deletions(-)

diff --git a/guix/import/git.scm b/guix/import/git.scm
index 8fd5d70af9..e4d35ed87f 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 32b9d36f2a..83095a398f 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -249,7 +249,7 @@ 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
@@ -290,15 +290,21 @@ 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 (lambda (x) (string=? version (car x)))
+                          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)
+(define* (latest-release pkg #:key (version #f))
   "Return an <upstream-source> for the latest release of PKG."
   (define (github-uri uri)
     (match uri
@@ -313,7 +319,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)



reply via email to

[Prev in Thread] Current Thread [Next in Thread]