From: Maxime Devos <maximedevos@telenet.be>
To: 53060@debbugs.gnu.org
Cc: Maxime Devos <maximedevos@telenet.be>
Subject: [bug#53060] [PATCH 1/2] import/github: Return <git-reference> objects for git-fetch origins.
Date: Thu, 6 Jan 2022 20:50:11 +0000 [thread overview]
Message-ID: <20220106205012.67352-1-maximedevos@telenet.be> (raw)
In-Reply-To: <538acb9dc52f6992a5a65846db48f8b7382fb1be.camel@telenet.be>
* guix/import/github.scm
(latest-released-version): Also return the tag.
(latest-release): Use this information to return <git-reference> objects
when appropriate.
---
guix/import/github.scm | 43 ++++++++++++++++++++++++++----------------
1 file changed, 27 insertions(+), 16 deletions(-)
diff --git a/guix/import/github.scm b/guix/import/github.scm
index 888b148ffb..1adfb8d281 100644
--- a/guix/import/github.scm
+++ b/guix/import/github.scm
@@ -4,6 +4,7 @@
;;; Copyright © 2018 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2019 Arun Isaac <arunisaac@systemreboot.net>
;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -25,6 +26,7 @@ (define-module (guix import github)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-71)
#:use-module (guix utils)
#:use-module (guix i18n)
#:use-module (guix diagnostics)
@@ -181,12 +183,15 @@ (define headers
(x x)))))
(define (latest-released-version url package-name)
- "Return a string of the newest released version name given a string URL like
+ "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 if there is no releases"
+the package e.g. 'bedtools2'. Return #f (two values) if there are no
+releases."
(define (pre-release? x)
(assoc-ref x "prerelease"))
+ ;; This procedure returns (version . tag) pair, or #f
+ ;; if RELEASE doesn't seyem to correspond to a version.
(define (release->version release)
(let ((tag (or (assoc-ref release "tag_name") ;a "release"
(assoc-ref release "name"))) ;a tag
@@ -197,22 +202,22 @@ (define (release->version release)
((and (< name-length (string-length tag))
(string=? (string-append package-name "-")
(substring tag 0 (+ name-length 1))))
- (substring tag (+ name-length 1)))
+ (cons (substring tag (+ name-length 1)) tag))
;; some tags start with a "v" e.g. "v0.25.0"
;; or with the word "version" e.g. "version.2.1"
;; where some are just the version number
((string-prefix? "version" tag)
- (if (char-set-contains? char-set:digit (string-ref tag 7))
- (substring tag 7)
- (substring tag 8)))
+ (cons (if (char-set-contains? char-set:digit (string-ref tag 7))
+ (substring tag 7)
+ (substring tag 8)) tag))
((string-prefix? "v" tag)
- (substring tag 1))
+ (cons (substring tag 1) tag))
;; Finally, reject tags that don't start with a digit:
;; they may not represent a release.
((and (not (string-null? tag))
(char-set-contains? char-set:digit
(string-ref tag 0)))
- tag)
+ (cons tag tag))
(else #f))))
(let* ((json (and=> (fetch-releases-or-tags url)
@@ -229,14 +234,14 @@ (define (release->version release)
(match (remove pre-release? json)
(() json) ; keep everything
(releases releases)))
- version>?)
- ((latest-release . _) latest-release)
- (() #f)))))
+ (lambda (x y) (version>? (car x) (car y))))
+ (((latest-version . tag) . _) (values latest-version tag))
+ (() (values #f #f))))))
(define (latest-release pkg)
"Return an <upstream-source> for the latest release of PKG."
- (define (origin-github-uri origin)
- (match (origin-uri origin)
+ (define (github-uri uri)
+ (match uri
((? string? url)
url) ;surely a github.com URL
((? download:git-reference? ref)
@@ -244,14 +249,20 @@ (define (origin-github-uri origin)
((urls ...)
(find (cut string-contains <> "github.com") urls))))
- (let* ((source-uri (origin-github-uri (package-source pkg)))
+ (let* ((original-uri (origin-uri (package-source pkg)))
+ (source-uri (github-uri original-uri))
(name (package-name pkg))
- (newest-version (latest-released-version source-uri name)))
+ (newest-version version-tag
+ (latest-released-version source-uri name)))
(if newest-version
(upstream-source
(package name)
(version newest-version)
- (urls (list (updated-github-url pkg newest-version))))
+ (urls (if (download:git-reference? original-uri)
+ (download:git-reference
+ (inherit original-uri)
+ (commit version-tag))
+ (list (updated-github-url pkg newest-version)))))
#f))) ; On GitHub but no proper releases
(define %github-updater
base-commit: 90bc18bcd4d221b53e52f94039d256d2a8edea5b
prerequisite-patch-id: 2888bb74d524c7eee9edef94c8f06f099291e7d9
prerequisite-patch-id: 24d16d7354ddca4822f631a883c8e8789c818533
prerequisite-patch-id: ab72bad504c2df472d539b6a8205fed9c89416ab
prerequisite-patch-id: 8c91ca86901e3f61d1363d521fa825ac680f60d8
--
2.34.0
next prev parent reply other threads:[~2022-01-06 20:51 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2022-01-06 20:48 [bug#53060] [PATCH 0/2] Allow the github updater to update git sources Maxime Devos
2022-01-06 20:50 ` Maxime Devos [this message]
2022-01-06 20:50 ` [bug#53060] [PATCH 2/2] import/github: Test it Maxime Devos
2022-01-16 22:19 ` [bug#53060] [PATCH 0/2] Allow the github updater to update git sources Ludovic Courtès
2022-01-17 10:12 ` Maxime Devos
2022-01-17 13:13 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220106205012.67352-1-maximedevos@telenet.be \
--to=maximedevos@telenet.be \
--cc=53060@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.