From patchwork Thu Jan 6 20:50:11 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: M X-Patchwork-Id: 36051 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 29FC527BBEA; Thu, 6 Jan 2022 20:51:59 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,FREEMAIL_FROM,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3, RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 9CA8C27BBE9 for ; Thu, 6 Jan 2022 20:51:58 +0000 (GMT) Received: from localhost ([::1]:35900 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1n5Zjp-0007r1-RB for patchwork@mira.cbaines.net; Thu, 06 Jan 2022 15:51:57 -0500 Received: from eggs.gnu.org ([209.51.188.92]:34354) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1n5Ziw-0007ST-AS for guix-patches@gnu.org; Thu, 06 Jan 2022 15:51:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:49581) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1n5Ziw-00013K-0r for guix-patches@gnu.org; Thu, 06 Jan 2022 15:51:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1n5Ziw-0005c5-19 for guix-patches@gnu.org; Thu, 06 Jan 2022 15:51:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53060] [PATCH 1/2] import/github: Return objects for git-fetch origins. References: <538acb9dc52f6992a5a65846db48f8b7382fb1be.camel@telenet.be> In-Reply-To: <538acb9dc52f6992a5a65846db48f8b7382fb1be.camel@telenet.be> Resent-From: Maxime Devos Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 06 Jan 2022 20:51:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 53060 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53060@debbugs.gnu.org Cc: Maxime Devos Received: via spool by 53060-submit@debbugs.gnu.org id=B53060.164150221621514 (code B ref 53060); Thu, 06 Jan 2022 20:51:01 +0000 Received: (at 53060) by debbugs.gnu.org; 6 Jan 2022 20:50:16 +0000 Received: from localhost ([127.0.0.1]:42482 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5ZiC-0005av-8H for submit@debbugs.gnu.org; Thu, 06 Jan 2022 15:50:16 -0500 Received: from michel.telenet-ops.be ([195.130.137.88]:43218) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1n5ZiB-0005ah-2i for 53060@debbugs.gnu.org; Thu, 06 Jan 2022 15:50:15 -0500 Received: from localhost.localdomain ([IPv6:2a02:1811:8c09:9d00:3c5f:2eff:feb0:ba5a]) by michel.telenet-ops.be with bizsmtp id fYqD260094UW6Th06YqDBT; Thu, 06 Jan 2022 21:50:13 +0100 From: Maxime Devos Date: Thu, 6 Jan 2022 20:50:11 +0000 Message-Id: <20220106205012.67352-1-maximedevos@telenet.be> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=telenet.be; s=r22; t=1641502213; bh=dYJu5z7gAB6SomKy1Tq8oIwY6UsejtiveeCsbVZ4gy4=; h=From:To:Cc:Subject:Date; b=TTi7gE+aWyaOBkWIoIWbd2XVaRzvNMoHqhc7+fOfq2MRhFG93iViDBL4OMSbth3bJ CvnSJEwHMpYmewpxxy2Dn6HpbPQWY3uKYvMjwxpkAPdH6tUxEEVu3NGlHg3pldIqRj FTrgujy1LECElJRrvRFY57TaGNvUvp9bk7srUZicxGMvRKTib0/9UW7rWhUBUxndKe Q7XGf5KlxGMTxkT9BMDXlzUZWZzUpY0CWZFW/o9f/EKh5AsFtRbOjldOPA9CzX6iE9 +B2wBRm8tA1yHm+a1i2FFZiEkuAkNFQUm2j16a33SIjgySA3OtbyvWUYLdzxmnxGVV b0opNPhyMNgsg== X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * guix/import/github.scm (latest-released-version): Also return the tag. (latest-release): Use this information to return objects when appropriate. --- guix/import/github.scm | 43 ++++++++++++++++++++++++++---------------- 1 file changed, 27 insertions(+), 16 deletions(-) base-commit: 90bc18bcd4d221b53e52f94039d256d2a8edea5b prerequisite-patch-id: 2888bb74d524c7eee9edef94c8f06f099291e7d9 prerequisite-patch-id: 24d16d7354ddca4822f631a883c8e8789c818533 prerequisite-patch-id: ab72bad504c2df472d539b6a8205fed9c89416ab prerequisite-patch-id: 8c91ca86901e3f61d1363d521fa825ac680f60d8 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 ;;; Copyright © 2019 Arun Isaac ;;; Copyright © 2019 Efraim Flashner +;;; Copyright © 2022 Maxime Devos ;;; ;;; 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 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