unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#50359] [PATCH] import: Add 'generic-git' updater.
@ 2021-09-03 15:50 Xinglu Chen
  2021-09-05  0:19 ` Sarah Morgensen
                   ` (2 more replies)
  0 siblings, 3 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-03 15:50 UTC (permalink / raw)
  To: 50359

* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* Makefile.am (MODULES): Register it.
---
This patch adds a new ‘generic-git’ updater which can check for new tags
for package hosted on Git repos.  However, it cannot download Git repos
and update the package definitions, i.e. ‘guix refresh -u’.  There is a
pending patch that would add this feature though[1].

‘guix refresh -L’ now reports

  Available updaters:
  […]
  94.5% of the packages are covered by these updaters.

We are getting close to 100% :-)

See it in action!

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix refresh harmonist scdoc gmnisrv
gnu/packages/web.scm:7931:4: warning: no tags were found for package `gmnisrv'
gnu/packages/web.scm:7931:4: warning: 'generic-git' updater failed to determine available releases for gmnisrv
gnu/packages/man.scm:339:12: scdoc would be upgraded from 1.10.1 to 1.11.1
gnu/packages/games.scm:9433:2: warning: failed to fetch Git repository for package `harmonist'
gnu/packages/games.scm:9433:2: warning: 'generic-git' updater failed to determine available releases for harmonist
--8<---------------cut here---------------end--------------->8---
  
[1]: <https://issues.guix.gnu.org/50072>

 Makefile.am         |   1 +
 doc/guix.texi       |  27 ++++++
 guix/import/git.scm | 223 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 251 insertions(+)
 create mode 100644 guix/import/git.scm

diff --git a/Makefile.am b/Makefile.am
index 3c79760734..c4d3a456b1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 36a0c7f5ec..26afb1607a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((tag-prefix . "^release0-")
+      (tag-suffix . "[a-z]?$")
+      (tag-version-delimiter . ":"))))
+@end lisp      
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..9a654c1972
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,223 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-28)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:export (%generic-git-updater))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `tag-prefix',
+;;; `tag-suffix' and `tag-version-delimiter' properties of the package to make
+;;; the updater parse the Git tag name correctly.
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-tag-error &error
+  git-tag-error?
+  (kind git-tag-error-kind))
+
+(define (git-tag-error kind)
+  (raise (condition (&message (message (format "bad `~a' property")))
+                    (&git-tag-error
+                     (kind kind)))))
+
+(define (git-tag-warning package c)
+  (warning (package-location package)
+           (G_ "~a for package `~a'~%")
+           (condition-message c)
+           (package-name package)))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+(define (git-no-tags-warning package c)
+  (warning (package-location package)
+           (G_ "~a for package `~a'~%")
+           (condition-message c)
+           (package-name package)))
+
+(define (git-fetch-warning package)
+  (warning (package-location package)
+           (G_ "failed to fetch Git repository for package `~a'~%")
+           (package-name package)))
+
+\f
+;;; Helper functions
+
+(define (string-split* str delim)
+  "Like `string-split', but DELIM is a string instead of a
+char-set."
+  (filter (lambda (str) (not (equal? str "")))
+          (string-split str (string->char-set delim))))
+
+(define* (get-version package tag #:key prefix suffix delim)
+  (define delim* (if delim delim "."))
+  (define prefix-regexp "^[^0-9]*")
+  (define suffix-regexp (string-append "[^0-9" (regexp-quote delim*) "]*$"))
+  (define delim-regexp (string-append "^[0-9]+" (regexp-quote delim*) "[0-9]+"))
+
+  (define no-prefix
+    (let ((match (string-match (or prefix prefix-regexp) tag)))
+      (if match
+          (regexp-substitute #f match 'post)
+          (git-tag-error 'tag-prefix))))
+
+  (define no-suffix
+    (let ((match (string-match (or suffix suffix-regexp) no-prefix)))
+      (if match
+          (regexp-substitute #f match 'pre)
+          (git-tag-error 'tag-suffix))))
+
+  (define no-delims
+    (if (string-match delim-regexp no-suffix)
+        (string-split* no-suffix delim*)
+        (git-tag-error 'tag-version-delimiter)))
+
+  (string-join no-delims "."))
+
+(define (sort-tags tags)
+  "Sort TAGS, a list if Git tags, such that the latest tag is the last element."
+  (sort tags (lambda (a b)
+               (eq? (version-compare a b) '<))))
+
+\f
+;;; Updater
+
+(define (get-remote url git-uri)
+  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
+  (let* ((checkout (update-cached-checkout url
+                                           #:recursive?
+                                           (git-reference-recursive? git-uri)))
+         (repository (repository-open checkout)))
+    (remote-lookup repository "origin")))
+
+(define (get-latest-tag remote)
+  "Given a Git REMOTE, return that latest tag available."
+  (remote-connect remote)
+
+  (define tags
+    (sort-tags
+     (map (lambda (tag)
+            (string-drop tag (string-length "refs/tags/")))
+          (filter (lambda (ref)
+                    ;; Every tag has two refs:
+                    ;;
+                    ;; * refs/tags/1.2.3^{}
+                    ;; * refs/tags/1.2.3
+                    ;;
+                    ;; remove the one with the trailing ^{}
+                    (and (not (string-suffix? "^{}" ref))
+                         (string-prefix? "refs/tags/" ref)))
+                  (map (lambda (remote-head)
+                         (remote-head-name remote-head))
+                       (remote-ls remote))))))
+
+  (remote-disconnect remote)
+
+  (if (null? tags)
+      (git-no-tags-error)
+      (last tags)))
+
+(define (latest-git-tag-version package tag-prefix tag-suffix
+                                tag-version-delimiter)
+  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, and TAG-VERSION-DELIMITER
+properties of PACKAGE, returns the latest version of PACKAGE."
+  (guard (c ((eq? (exception-kind c) 'git-error)
+             (git-fetch-warning package)
+             #f)
+            ((git-tag-error? c)
+             (git-tag-warning package c)
+             #f)
+            ((git-no-tags-error? c)
+             (git-no-tags-warning package c)
+             #f))
+    (let* ((source (package-source package))
+           (git-uri (origin-uri source))
+           (url (git-reference-url (origin-uri source)))
+           (remote (get-remote url git-uri))
+           (latest-tag (get-latest-tag remote)))
+      (get-version package
+                   latest-tag
+                   #:prefix tag-prefix
+                   #:suffix tag-suffix
+                   #:delim tag-version-delimiter))))
+
+(define (git-package? package)
+  "Whether the origin of PACKAGE is a Git repostiory."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (properties (package-properties package))
+         (tag-prefix (assq-ref properties 'tag-prefix))
+         (tag-suffix (assq-ref properties 'tag-suffix))
+         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package
+                                              tag-prefix
+                                              tag-suffix
+                                              tag-version-delimiter)))
+
+    (if new-version
+        (upstream-source
+         (package name)
+         (version new-version)
+         (urls (list url)))
+        ;; No new release or no tags available.
+        #f)))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))

base-commit: 9540323458de87b0b8aa421e449a4fe27af7c393
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-03 15:50 [bug#50359] [PATCH] import: Add 'generic-git' updater Xinglu Chen
@ 2021-09-05  0:19 ` Sarah Morgensen
  2021-09-05  1:03   ` Sarah Morgensen
                     ` (2 more replies)
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
  2021-09-15  8:44 ` [bug#50359] [PATCH 3/3] import: " iskarian
  2 siblings, 3 replies; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-05  0:19 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 9501 bytes --]

Hello,

Thanks for the patch!  Glad to see this idea becoming more polished.

Xinglu Chen <public@yoctocell.xyz> writes:

> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * Makefile.am (MODULES): Register it.
> ---
> This patch adds a new ‘generic-git’ updater which can check for new tags
> for package hosted on Git repos.  However, it cannot download Git repos
> and update the package definitions, i.e. ‘guix refresh -u’.  There is a
> pending patch that would add this feature though[1].
>
> ‘guix refresh -L’ now reports
>
>   Available updaters:
>   […]
>   94.5% of the packages are covered by these updaters.
>
> We are getting close to 100% :-)

Wow, that is close!

>
> See it in action!
>
> $ ./pre-inst-env guix refresh harmonist scdoc gmnisrv
> gnu/packages/web.scm:7931:4: warning: no tags were found for package `gmnisrv'
> gnu/packages/web.scm:7931:4: warning: 'generic-git' updater failed to determine available releases for gmnisrv
> gnu/packages/man.scm:339:12: scdoc would be upgraded from 1.10.1 to 1.11.1
> gnu/packages/games.scm:9433:2: warning: failed to fetch Git repository for package `harmonist'
> gnu/packages/games.scm:9433:2: warning: 'generic-git' updater failed to determine available releases for harmonist

FWIW, harmonist and a few other packages fail to work because they use
an old git protocol which is not supported by libgit2.

[...]
> +
> +@itemize
> +@item @code{tag-prefix}: a regular expression for matching a prefix of
> +the tag name.
> +
> +@item @code{tag-suffix}: a regular expression for matching a suffix of
> +the tag name.
> +
> +@item @code{tag-version-delimiter}: a string used as the delimiter in
> +the tag name for separating the numbers of the version.
> +@end itemize
> +
> +@lisp
> +(package
> +  (name "foo")
> +  ;; ...
> +  (properties
> +    '((tag-prefix . "^release0-")
> +      (tag-suffix . "[a-z]?$")
> +      (tag-version-delimiter . ":"))))
> +@end lisp
             ^ extra whitespace

I do like the selection of (prefix, suffix, delimiter), though I think
there are only one or two packages which use a different delimiter.

[...]
> +;;; Errors & warnings
> +
> +(define-condition-type &git-tag-error &error
> +  git-tag-error?
> +  (kind git-tag-error-kind))
> +
> +(define (git-tag-error kind)
> +  (raise (condition (&message (message (format "bad `~a' property")))
> +                    (&git-tag-error
> +                     (kind kind)))))

When I trigger this error, I get:
--8<---------------cut here---------------start------------->8---
In ice-9/exceptions.scm:
   406:15  6 (latest-git-release _)
In ice-9/boot-9.scm:
  1752:10  5 (with-exception-handler _ _ #:unwind? _ # _)
In guix/import/git.scm:
    59:39  4 (get-version _ _ #:prefix _ #:suffix _ #:delim _)
In unknown file:
           3 (simple-format #f "bad `~a' property")
In ice-9/boot-9.scm:
  1685:16  2 (raise-exception _ #:continuable? _)
  1683:16  1 (raise-exception _ #:continuable? _)
  1685:16  0 (raise-exception _ #:continuable? _)

ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure simple-format: FORMAT: Missing argument for ~a
--8<---------------cut here---------------end--------------->8---

> +
> +(define (git-tag-warning package c)
> +  (warning (package-location package)
> +           (G_ "~a for package `~a'~%")
> +           (condition-message c)
> +           (package-name package)))
> +
> +(define-condition-type &git-no-tags-error &error
> +  git-no-tags-error?)
> +
> +(define (git-no-tags-error)
> +  (raise (condition (&message (message "no tags were found"))
> +                    (&git-no-tags-error))))
> +
> +(define (git-no-tags-warning package c)
> +  (warning (package-location package)
> +           (G_ "~a for package `~a'~%")
> +           (condition-message c)
> +           (package-name package)))
> +
> +(define (git-fetch-warning package)
> +  (warning (package-location package)
> +           (G_ "failed to fetch Git repository for package `~a'~%")
> +           (package-name package)))
> +
> +\f
> +;;; Helper functions
> +
> +(define (string-split* str delim)
> +  "Like `string-split', but DELIM is a string instead of a
> +char-set."
> +  (filter (lambda (str) (not (equal? str "")))
> +          (string-split str (string->char-set delim))))

  (string-split* "1:2.3" ":.") -> ("1" "2" "3")
  (string-split* "1a2b3" "ab") -> ("1" "2" "3")

Is this what you intended?  The documentation above makes it sound like
the whole string serves as the delimiter.

> +
> +(define* (get-version package tag #:key prefix suffix delim)

PACKAGE is not used by this procedure.

> +  (define delim* (if delim delim "."))
> +  (define prefix-regexp "^[^0-9]*")
> +  (define suffix-regexp (string-append "[^0-9" (regexp-quote delim*) "]*$"))

With a delimiter of '.', this would say the suffix of '1.2.3.prerelease'
is 'prerelease', not '.prerelease'.  Is this correct?  (I would be
tempted to just remove delim* from this.)

> +  (define delim-regexp (string-append "^[0-9]+" (regexp-quote delim*) "[0-9]+"))

This fails to account for versions which use non-numerics, such as (all
taken from the package-version field of packages using git-fetch and
which use this version as the tag):

1.0.0-beta.0
0.0.9.4f
4.4-git.1
5.2.0-alpha
0.2.0-alpha-199-g3e7a475
20200701.154658.b0d6223
12-068oasis4
4.0.0.dev8
0.32-14-gcdfe14e
2.8-fix-2

There are about 50-60 packages like this.

I'm not sure how much effort should be spent including them, and for
some of them I'm not sure what our ideal behavior *is*.  Even if we
could reliably detect them, should "alpha" or "dev" packages be returned
by the updater?

Upon investigation, there is a deeper problem: version-compare thinks
"5.2.0" is a lower version than "5.2.0-alpha", and that "4.0.0" is lower
than "4.0.0.dev8".

scheme@(guile-user)> (version-compare "5.1.9" "5.2.0")
$5 = <
scheme@(guile-user)> (version-compare "5.2.0" "5.2.0-alpha")
$6 = <
scheme@(guile-user)> (version-compare "4.0.0" "4.0.0.dev8")
$7 = <

> +
> +  (define no-prefix
> +    (let ((match (string-match (or prefix prefix-regexp) tag)))
> +      (if match
> +          (regexp-substitute #f match 'post)
> +          (git-tag-error 'tag-prefix))))
> +
> +  (define no-suffix
> +    (let ((match (string-match (or suffix suffix-regexp) no-prefix)))
> +      (if match
> +          (regexp-substitute #f match 'pre)
> +          (git-tag-error 'tag-suffix))))
> +
> +  (define no-delims
> +    (if (string-match delim-regexp no-suffix)
> +        (string-split* no-suffix delim*)
> +        (git-tag-error 'tag-version-delimiter)))

This throws an error if the version doesn't have any delimiter.

Actually, it throws an error in a lot of other cases too, often saying
the 'tag-version-delimiter is wrong when it's something else.  Consider
the tags from the "openjpeg" package, sorted by 'sort-tags':

arelease
opj0-97
start
v2.1.1
v2.1.2
v2.2.0
v2.3.0
v2.3.1
v2.4.0
version.1.0
version.1.1
version.1.2
version.1.3
version.1.4
version.1.5
version.1.5.1
version.1.5.2
version.2.0
version.2.0.1
version.2.1
wg1n6848

At first, 'get-version' throws an error because "wg1n6848" doesn't have
a delimiter. But even disregarding that, it would return "version.2.1"
-> "2.1" as the latest version.

Probably we should process all tags with 'get-version' (simply skipping
any that don't parse) and use that to sort the tags.  If none parse with
'get-version' we could use the "no tags" error or have a separate error
for "there were tags but we couldn't process them".

And this lets us just do something like (untested):

(define* (get-version tag #:key prefix suffix delim)
  (define delim-rx (regexp-quote (or delim ".")))
  (define prefix-rx (or prefix "[^[:digit:]]*"))
  (define suffix-rx (or suffix ".*"))
  (define version-char-rx
   (string-append "[^" delim-rx "[:punct:]]"))

  (define tag-rx
   (string-append "^" prefix "(" version-char-rx "+("
                  delim-rx version-char-rx ")*)" suffix-rx "$"))

  (and=> (string-match tag-rx tag)
         (cut match-substring <> 1)))

Though at this point, 'tag-rx' should probably be constructed and
compiled outside the loop.

> +
> +  (string-join no-delims "."))
> +
> +(define (sort-tags tags)
> +  "Sort TAGS, a list if Git tags, such that the latest tag is the last element."
> +  (sort tags (lambda (a b)
> +               (eq? (version-compare a b) '<))))
> +
> +\f
> +;;; Updater
> +
> +(define (get-remote url git-uri)
> +  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
> +  (let* ((checkout (update-cached-checkout url
> +                                           #:recursive?
> +                                           (git-reference-recursive? git-uri)))
> +         (repository (repository-open checkout)))
> +    (remote-lookup repository "origin")))

We surely don't want 'update-cached-checkout' since that fetches the
whole repo history!  I've attached a patch below (based on top of this
one) which brings the total time-per-package to under 1s.  I moved it to
(guix git) to make use of 'with-libgit2' which ensures we use system
certificates.

Apologies for such a long reply. I hope it was helpful :)

--
Sarah


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: git: Add 'ls-remote-refs'. --]
[-- Type: text/x-patch, Size: 4741 bytes --]

From 0b0973034711e15b52702c0aec0c653dfd41928c Mon Sep 17 00:00:00 2001
Message-Id: <0b0973034711e15b52702c0aec0c653dfd41928c.1630800771.git.iskarian@mgsn.dev>
From: Sarah Morgensen <iskarian@mgsn.dev>
Date: Fri, 3 Sep 2021 22:40:02 -0700
Subject: [PATCH] git: Add 'ls-remote-refs'.

---
 guix/git.scm        | 33 +++++++++++++++++++++++++++++++
 guix/import/git.scm | 47 ++++++++++-----------------------------------
 2 files changed, 43 insertions(+), 37 deletions(-)

diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..b784fd6d20 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -56,6 +56,8 @@
             commit-difference
             commit-relation
 
+            ls-remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (ls-remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and ref?
+         (or (not tags?) (tag? ref))))
+
+  (with-libgit2
+   (with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+        (remote-disconnect remote)
+        (repository-close! repository)
+
+        (filter include? (map remote-head-name (remote-ls remote))))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
index 9a654c1972..097a2f70bc 100644
--- a/guix/import/git.scm
+++ b/guix/import/git.scm
@@ -17,7 +17,6 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix import git)
-  #:use-module (git)
   #:use-module (guix build utils)
   #:use-module (guix diagnostics)
   #:use-module (guix git)
@@ -126,40 +125,15 @@ char-set."
 \f
 ;;; Updater
 
-(define (get-remote url git-uri)
-  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
-  (let* ((checkout (update-cached-checkout url
-                                           #:recursive?
-                                           (git-reference-recursive? git-uri)))
-         (repository (repository-open checkout)))
-    (remote-lookup repository "origin")))
-
-(define (get-latest-tag remote)
-  "Given a Git REMOTE, return that latest tag available."
-  (remote-connect remote)
-
-  (define tags
-    (sort-tags
-     (map (lambda (tag)
-            (string-drop tag (string-length "refs/tags/")))
-          (filter (lambda (ref)
-                    ;; Every tag has two refs:
-                    ;;
-                    ;; * refs/tags/1.2.3^{}
-                    ;; * refs/tags/1.2.3
-                    ;;
-                    ;; remove the one with the trailing ^{}
-                    (and (not (string-suffix? "^{}" ref))
-                         (string-prefix? "refs/tags/" ref)))
-                  (map (lambda (remote-head)
-                         (remote-head-name remote-head))
-                       (remote-ls remote))))))
-
-  (remote-disconnect remote)
-
-  (if (null? tags)
-      (git-no-tags-error)
-      (last tags)))
+(define (get-latest-tag url)
+  "Return the latest tag available from the Git repository at URL."
+  (let ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                   (ls-remote-refs url #:tags? #t))))
+
+    (if (null? tags)
+        (git-no-tags-error)
+        (last (sort-tags tags)))))
+
 
 (define (latest-git-tag-version package tag-prefix tag-suffix
                                 tag-version-delimiter)
@@ -177,8 +151,7 @@ properties of PACKAGE, returns the latest version of PACKAGE."
     (let* ((source (package-source package))
            (git-uri (origin-uri source))
            (url (git-reference-url (origin-uri source)))
-           (remote (get-remote url git-uri))
-           (latest-tag (get-latest-tag remote)))
+           (latest-tag (get-latest-tag url)))
       (get-version package
                    latest-tag
                    #:prefix tag-prefix

base-commit: 522a3bf99cbc21a9093f63280b9508cd69b94ff0
prerequisite-patch-id: c60e771d96884a78a014e145723562a619c1a0e0
-- 
2.32.0


^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-05  0:19 ` Sarah Morgensen
@ 2021-09-05  1:03   ` Sarah Morgensen
  2021-09-05 10:36   ` Xinglu Chen
  2021-09-05 13:11   ` Xinglu Chen
  2 siblings, 0 replies; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-05  1:03 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359


Apologies, in my patch, 'with-temporary-directory' should be
'call-with-temporary-directory'...

Sarah Morgensen <iskarian@mgsn.dev> writes:

> +(define* (ls-remote-refs url #:key tags?)
> +  "Return the list of references advertised at Git repository URL.  If TAGS?
> +is true, limit to only refs/tags."
> +  (define (ref? ref)
> +    ;; Like `git ls-remote --refs', only show actual references.
> +    (and (string-prefix? "refs/" ref)
> +         (not (string-suffix? "^{}" ref))))
> +
> +  (define (tag? ref)
> +    (string-prefix? "refs/tags/" ref))
> +
> +  (define (include? ref)
> +    (and ref?
> +         (or (not tags?) (tag? ref))))
> +
> +  (with-libgit2
> +   (with-temporary-directory

...right here.

--
Sarah




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-05  0:19 ` Sarah Morgensen
  2021-09-05  1:03   ` Sarah Morgensen
@ 2021-09-05 10:36   ` Xinglu Chen
  2021-09-06  5:40     ` Sarah Morgensen
  2021-09-05 13:11   ` Xinglu Chen
  2 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-05 10:36 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 10852 bytes --]

On Sat, Sep 04 2021, Sarah Morgensen wrote:

> Hello,
>
> Thanks for the patch!  Glad to see this idea becoming more polished.
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> * guix/import/git.scm: New file.
>> * doc/guix.texi (Invoking guix refresh): Document it.
>> * Makefile.am (MODULES): Register it.
>> ---
>> This patch adds a new ‘generic-git’ updater which can check for new tags
>> for package hosted on Git repos.  However, it cannot download Git repos
>> and update the package definitions, i.e. ‘guix refresh -u’.  There is a
>> pending patch that would add this feature though[1].
>>
>> ‘guix refresh -L’ now reports
>>
>>   Available updaters:
>>   […]
>>   94.5% of the packages are covered by these updaters.
>>
>> We are getting close to 100% :-)
>
> Wow, that is close!
>
>>
>> See it in action!
>>
>> $ ./pre-inst-env guix refresh harmonist scdoc gmnisrv
>> gnu/packages/web.scm:7931:4: warning: no tags were found for package `gmnisrv'
>> gnu/packages/web.scm:7931:4: warning: 'generic-git' updater failed to determine available releases for gmnisrv
>> gnu/packages/man.scm:339:12: scdoc would be upgraded from 1.10.1 to 1.11.1
>> gnu/packages/games.scm:9433:2: warning: failed to fetch Git repository for package `harmonist'
>> gnu/packages/games.scm:9433:2: warning: 'generic-git' updater failed to determine available releases for harmonist
>
> FWIW, harmonist and a few other packages fail to work because they use
> an old git protocol which is not supported by libgit2.
>
> [...]
>> +
>> +@itemize
>> +@item @code{tag-prefix}: a regular expression for matching a prefix of
>> +the tag name.
>> +
>> +@item @code{tag-suffix}: a regular expression for matching a suffix of
>> +the tag name.
>> +
>> +@item @code{tag-version-delimiter}: a string used as the delimiter in
>> +the tag name for separating the numbers of the version.
>> +@end itemize
>> +
>> +@lisp
>> +(package
>> +  (name "foo")
>> +  ;; ...
>> +  (properties
>> +    '((tag-prefix . "^release0-")
>> +      (tag-suffix . "[a-z]?$")
>> +      (tag-version-delimiter . ":"))))
>> +@end lisp
>              ^ extra whitespace
>
> I do like the selection of (prefix, suffix, delimiter), though I think
> there are only one or two packages which use a different delimiter.
>
> [...]
>> +;;; Errors & warnings
>> +
>> +(define-condition-type &git-tag-error &error
>> +  git-tag-error?
>> +  (kind git-tag-error-kind))
>> +
>> +(define (git-tag-error kind)
>> +  (raise (condition (&message (message (format "bad `~a' property")))
>> +                    (&git-tag-error
>> +                     (kind kind)))))
>
> When I trigger this error, I get:
> --8<---------------cut here---------------start------------->8---
> In ice-9/exceptions.scm:
>    406:15  6 (latest-git-release _)
> In ice-9/boot-9.scm:
>   1752:10  5 (with-exception-handler _ _ #:unwind? _ # _)
> In guix/import/git.scm:
>     59:39  4 (get-version _ _ #:prefix _ #:suffix _ #:delim _)
> In unknown file:
>            3 (simple-format #f "bad `~a' property")
> In ice-9/boot-9.scm:
>   1685:16  2 (raise-exception _ #:continuable? _)
>   1683:16  1 (raise-exception _ #:continuable? _)
>   1685:16  0 (raise-exception _ #:continuable? _)
>
> ice-9/boot-9.scm:1685:16: In procedure raise-exception:
> In procedure simple-format: FORMAT: Missing argument for ~a
> --8<---------------cut here---------------end--------------->8---

Oops, it should be

  (format "bad `~a' property" kind)
  
>> +
>> +(define (git-tag-warning package c)
>> +  (warning (package-location package)
>> +           (G_ "~a for package `~a'~%")
>> +           (condition-message c)
>> +           (package-name package)))
>> +
>> +(define-condition-type &git-no-tags-error &error
>> +  git-no-tags-error?)
>> +
>> +(define (git-no-tags-error)
>> +  (raise (condition (&message (message "no tags were found"))
>> +                    (&git-no-tags-error))))
>> +
>> +(define (git-no-tags-warning package c)
>> +  (warning (package-location package)
>> +           (G_ "~a for package `~a'~%")
>> +           (condition-message c)
>> +           (package-name package)))
>> +
>> +(define (git-fetch-warning package)
>> +  (warning (package-location package)
>> +           (G_ "failed to fetch Git repository for package `~a'~%")
>> +           (package-name package)))
>> +
>> +\f
>> +;;; Helper functions
>> +
>> +(define (string-split* str delim)
>> +  "Like `string-split', but DELIM is a string instead of a
>> +char-set."
>> +  (filter (lambda (str) (not (equal? str "")))
>> +          (string-split str (string->char-set delim))))
>
>   (string-split* "1:2.3" ":.") -> ("1" "2" "3")
>   (string-split* "1a2b3" "ab") -> ("1" "2" "3")
>
> Is this what you intended?  The documentation above makes it sound like
> the whole string serves as the delimiter.

It’s not what I wanted, indeed.  I will try to fix it.

>> +
>> +(define* (get-version package tag #:key prefix suffix delim)
>
> PACKAGE is not used by this procedure.

Good catch, it was some leftover I forgot to remove.

>> +  (define delim* (if delim delim "."))
>> +  (define prefix-regexp "^[^0-9]*")
>> +  (define suffix-regexp (string-append "[^0-9" (regexp-quote delim*) "]*$"))
>
> With a delimiter of '.', this would say the suffix of '1.2.3.prerelease'
> is 'prerelease', not '.prerelease'.  Is this correct?  (I would be
> tempted to just remove delim* from this.)

Good point, I think removing ‘delim*’ would be a good idea.

>> +  (define delim-regexp (string-append "^[0-9]+" (regexp-quote delim*) "[0-9]+"))
>
> This fails to account for versions which use non-numerics, such as (all
> taken from the package-version field of packages using git-fetch and
> which use this version as the tag):
>
> 1.0.0-beta.0
> 0.0.9.4f
> 4.4-git.1
> 5.2.0-alpha
> 0.2.0-alpha-199-g3e7a475
> 20200701.154658.b0d6223
> 12-068oasis4
> 4.0.0.dev8
> 0.32-14-gcdfe14e
> 2.8-fix-2
>
> There are about 50-60 packages like this.
>
> I'm not sure how much effort should be spent including them, and for
> some of them I'm not sure what our ideal behavior *is*.  Even if we
> could reliably detect them, should "alpha" or "dev" packages be returned
> by the updater?

I don’t think we usually include alpha or rc releases, so updater
probably shouldn’t return them either.  Not sure how we would try to
detect alpha/beta/rc releases, though, besides running something like

  (string-match? "(alpha|beta|rc|dev)" TAG)

On each tag.

> Upon investigation, there is a deeper problem: version-compare thinks
> "5.2.0" is a lower version than "5.2.0-alpha", and that "4.0.0" is lower
> than "4.0.0.dev8".
>
> scheme@(guile-user)> (version-compare "5.1.9" "5.2.0")
> $5 = <
> scheme@(guile-user)> (version-compare "5.2.0" "5.2.0-alpha")
> $6 = <
> scheme@(guile-user)> (version-compare "4.0.0" "4.0.0.dev8")
> $7 = <

Maybe we should filter the tags before comparing them; that should
get rid of these pre-release tags.

>> +
>> +  (define no-prefix
>> +    (let ((match (string-match (or prefix prefix-regexp) tag)))
>> +      (if match
>> +          (regexp-substitute #f match 'post)
>> +          (git-tag-error 'tag-prefix))))
>> +
>> +  (define no-suffix
>> +    (let ((match (string-match (or suffix suffix-regexp) no-prefix)))
>> +      (if match
>> +          (regexp-substitute #f match 'pre)
>> +          (git-tag-error 'tag-suffix))))
>> +
>> +  (define no-delims
>> +    (if (string-match delim-regexp no-suffix)
>> +        (string-split* no-suffix delim*)
>> +        (git-tag-error 'tag-version-delimiter)))
>
> This throws an error if the version doesn't have any delimiter.

Setting the ‘tag-version-delimiter’ prefix to an empty string would
solve this, right?  Or, maybe we should just get rid of the delimiter
thing since only a few packages use a different delimiter.

> Actually, it throws an error in a lot of other cases too, often saying
> the 'tag-version-delimiter is wrong when it's something else.  Consider
> the tags from the "openjpeg" package, sorted by 'sort-tags':
>
> arelease
> opj0-97
> start
> v2.1.1
> v2.1.2
> v2.2.0
> v2.3.0
> v2.3.1
> v2.4.0
> version.1.0
> version.1.1
> version.1.2
> version.1.3
> version.1.4
> version.1.5
> version.1.5.1
> version.1.5.2
> version.2.0
> version.2.0.1
> version.2.1
> wg1n6848
>
> At first, 'get-version' throws an error because "wg1n6848" doesn't have
> a delimiter. But even disregarding that, it would return "version.2.1"
> -> "2.1" as the latest version.
>
> Probably we should process all tags with 'get-version' (simply skipping
> any that don't parse) and use that to sort the tags.  If none parse with
> 'get-version' we could use the "no tags" error or have a separate error
> for "there were tags but we couldn't process them".

Ah, yes, that would be a good idea.

> And this lets us just do something like (untested):
>
> (define* (get-version tag #:key prefix suffix delim)
>   (define delim-rx (regexp-quote (or delim ".")))
>   (define prefix-rx (or prefix "[^[:digit:]]*"))
>   (define suffix-rx (or suffix ".*"))
>   (define version-char-rx
>    (string-append "[^" delim-rx "[:punct:]]"))
>
>   (define tag-rx
>    (string-append "^" prefix "(" version-char-rx "+("
>                   delim-rx version-char-rx ")*)" suffix-rx "$"))
>
>   (and=> (string-match tag-rx tag)
>          (cut match-substring <> 1)))
>
> Though at this point, 'tag-rx' should probably be constructed and
> compiled outside the loop.
>
>> +
>> +  (string-join no-delims "."))
>> +
>> +(define (sort-tags tags)
>> +  "Sort TAGS, a list if Git tags, such that the latest tag is the last element."
>> +  (sort tags (lambda (a b)
>> +               (eq? (version-compare a b) '<))))
>> +
>> +\f
>> +;;; Updater
>> +
>> +(define (get-remote url git-uri)
>> +  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
>> +  (let* ((checkout (update-cached-checkout url
>> +                                           #:recursive?
>> +                                           (git-reference-recursive? git-uri)))
>> +         (repository (repository-open checkout)))
>> +    (remote-lookup repository "origin")))
>
> We surely don't want 'update-cached-checkout' since that fetches the
> whole repo history!  I've attached a patch below (based on top of this
> one) which brings the total time-per-package to under 1s.  I moved it to
> (guix git) to make use of 'with-libgit2' which ensures we use system
> certificates.
>
> Apologies for such a long reply. I hope it was helpful :)

No worries, it definitely helped a lot, thank you!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-05  0:19 ` Sarah Morgensen
  2021-09-05  1:03   ` Sarah Morgensen
  2021-09-05 10:36   ` Xinglu Chen
@ 2021-09-05 13:11   ` Xinglu Chen
  2021-09-06  3:14     ` Sarah Morgensen
  2 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-05 13:11 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 27310 bytes --]

Some more comments after some testing

On Sat, Sep 04 2021, Sarah Morgensen wrote:

> Hello,
>
> Thanks for the patch!  Glad to see this idea becoming more polished.
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> * guix/import/git.scm: New file.
>> * doc/guix.texi (Invoking guix refresh): Document it.
>> * Makefile.am (MODULES): Register it.
>> ---
>> This patch adds a new ‘generic-git’ updater which can check for new tags
>> for package hosted on Git repos.  However, it cannot download Git repos
>> and update the package definitions, i.e. ‘guix refresh -u’.  There is a
>> pending patch that would add this feature though[1].
>>
>> ‘guix refresh -L’ now reports
>>
>>   Available updaters:
>>   […]
>>   94.5% of the packages are covered by these updaters.
>>
>> We are getting close to 100% :-)
>
> Wow, that is close!
>
>>
>> See it in action!
>>
>> $ ./pre-inst-env guix refresh harmonist scdoc gmnisrv
>> gnu/packages/web.scm:7931:4: warning: no tags were found for package `gmnisrv'
>> gnu/packages/web.scm:7931:4: warning: 'generic-git' updater failed to determine available releases for gmnisrv
>> gnu/packages/man.scm:339:12: scdoc would be upgraded from 1.10.1 to 1.11.1
>> gnu/packages/games.scm:9433:2: warning: failed to fetch Git repository for package `harmonist'
>> gnu/packages/games.scm:9433:2: warning: 'generic-git' updater failed to determine available releases for harmonist
>
> FWIW, harmonist and a few other packages fail to work because they use
> an old git protocol which is not supported by libgit2.
>
> [...]
>> +
>> +@itemize
>> +@item @code{tag-prefix}: a regular expression for matching a prefix of
>> +the tag name.
>> +
>> +@item @code{tag-suffix}: a regular expression for matching a suffix of
>> +the tag name.
>> +
>> +@item @code{tag-version-delimiter}: a string used as the delimiter in
>> +the tag name for separating the numbers of the version.
>> +@end itemize
>> +
>> +@lisp
>> +(package
>> +  (name "foo")
>> +  ;; ...
>> +  (properties
>> +    '((tag-prefix . "^release0-")
>> +      (tag-suffix . "[a-z]?$")
>> +      (tag-version-delimiter . ":"))))
>> +@end lisp
>              ^ extra whitespace
>
> I do like the selection of (prefix, suffix, delimiter), though I think
> there are only one or two packages which use a different delimiter.
>
> [...]
>> +;;; Errors & warnings
>> +
>> +(define-condition-type &git-tag-error &error
>> +  git-tag-error?
>> +  (kind git-tag-error-kind))
>> +
>> +(define (git-tag-error kind)
>> +  (raise (condition (&message (message (format "bad `~a' property")))
>> +                    (&git-tag-error
>> +                     (kind kind)))))
>
> When I trigger this error, I get:
> --8<---------------cut here---------------start------------->8---
> In ice-9/exceptions.scm:
>    406:15  6 (latest-git-release _)
> In ice-9/boot-9.scm:
>   1752:10  5 (with-exception-handler _ _ #:unwind? _ # _)
> In guix/import/git.scm:
>     59:39  4 (get-version _ _ #:prefix _ #:suffix _ #:delim _)
> In unknown file:
>            3 (simple-format #f "bad `~a' property")
> In ice-9/boot-9.scm:
>   1685:16  2 (raise-exception _ #:continuable? _)
>   1683:16  1 (raise-exception _ #:continuable? _)
>   1685:16  0 (raise-exception _ #:continuable? _)
>
> ice-9/boot-9.scm:1685:16: In procedure raise-exception:
> In procedure simple-format: FORMAT: Missing argument for ~a
> --8<---------------cut here---------------end--------------->8---
>
>> +
>> +(define (git-tag-warning package c)
>> +  (warning (package-location package)
>> +           (G_ "~a for package `~a'~%")
>> +           (condition-message c)
>> +           (package-name package)))
>> +
>> +(define-condition-type &git-no-tags-error &error
>> +  git-no-tags-error?)
>> +
>> +(define (git-no-tags-error)
>> +  (raise (condition (&message (message "no tags were found"))
>> +                    (&git-no-tags-error))))
>> +
>> +(define (git-no-tags-warning package c)
>> +  (warning (package-location package)
>> +           (G_ "~a for package `~a'~%")
>> +           (condition-message c)
>> +           (package-name package)))
>> +
>> +(define (git-fetch-warning package)
>> +  (warning (package-location package)
>> +           (G_ "failed to fetch Git repository for package `~a'~%")
>> +           (package-name package)))
>> +
>> +\f
>> +;;; Helper functions
>> +
>> +(define (string-split* str delim)
>> +  "Like `string-split', but DELIM is a string instead of a
>> +char-set."
>> +  (filter (lambda (str) (not (equal? str "")))
>> +          (string-split str (string->char-set delim))))
>
>   (string-split* "1:2.3" ":.") -> ("1" "2" "3")
>   (string-split* "1a2b3" "ab") -> ("1" "2" "3")
>
> Is this what you intended?  The documentation above makes it sound like
> the whole string serves as the delimiter.
>
>> +
>> +(define* (get-version package tag #:key prefix suffix delim)
>
> PACKAGE is not used by this procedure.
>
>> +  (define delim* (if delim delim "."))
>> +  (define prefix-regexp "^[^0-9]*")
>> +  (define suffix-regexp (string-append "[^0-9" (regexp-quote delim*) "]*$"))
>
> With a delimiter of '.', this would say the suffix of '1.2.3.prerelease'
> is 'prerelease', not '.prerelease'.  Is this correct?  (I would be
> tempted to just remove delim* from this.)
>
>> +  (define delim-regexp (string-append "^[0-9]+" (regexp-quote delim*) "[0-9]+"))
>
> This fails to account for versions which use non-numerics, such as (all
> taken from the package-version field of packages using git-fetch and
> which use this version as the tag):
>
> 1.0.0-beta.0
> 0.0.9.4f
> 4.4-git.1
> 5.2.0-alpha
> 0.2.0-alpha-199-g3e7a475
> 20200701.154658.b0d6223
> 12-068oasis4
> 4.0.0.dev8
> 0.32-14-gcdfe14e
> 2.8-fix-2
>
> There are about 50-60 packages like this.
>
> I'm not sure how much effort should be spent including them, and for
> some of them I'm not sure what our ideal behavior *is*.  Even if we
> could reliably detect them, should "alpha" or "dev" packages be returned
> by the updater?
>
> Upon investigation, there is a deeper problem: version-compare thinks
> "5.2.0" is a lower version than "5.2.0-alpha", and that "4.0.0" is lower
> than "4.0.0.dev8".
>
> scheme@(guile-user)> (version-compare "5.1.9" "5.2.0")
> $5 = <
> scheme@(guile-user)> (version-compare "5.2.0" "5.2.0-alpha")
> $6 = <
> scheme@(guile-user)> (version-compare "4.0.0" "4.0.0.dev8")
> $7 = <
>
>> +
>> +  (define no-prefix
>> +    (let ((match (string-match (or prefix prefix-regexp) tag)))
>> +      (if match
>> +          (regexp-substitute #f match 'post)
>> +          (git-tag-error 'tag-prefix))))
>> +
>> +  (define no-suffix
>> +    (let ((match (string-match (or suffix suffix-regexp) no-prefix)))
>> +      (if match
>> +          (regexp-substitute #f match 'pre)
>> +          (git-tag-error 'tag-suffix))))
>> +
>> +  (define no-delims
>> +    (if (string-match delim-regexp no-suffix)
>> +        (string-split* no-suffix delim*)
>> +        (git-tag-error 'tag-version-delimiter)))
>
> This throws an error if the version doesn't have any delimiter.
>
> Actually, it throws an error in a lot of other cases too, often saying
> the 'tag-version-delimiter is wrong when it's something else.  Consider
> the tags from the "openjpeg" package, sorted by 'sort-tags':
>
> arelease
> opj0-97
> start
> v2.1.1
> v2.1.2
> v2.2.0
> v2.3.0
> v2.3.1
> v2.4.0
> version.1.0
> version.1.1
> version.1.2
> version.1.3
> version.1.4
> version.1.5
> version.1.5.1
> version.1.5.2
> version.2.0
> version.2.0.1
> version.2.1
> wg1n6848
>
> At first, 'get-version' throws an error because "wg1n6848" doesn't have
> a delimiter. But even disregarding that, it would return "version.2.1"
> -> "2.1" as the latest version.
>
> Probably we should process all tags with 'get-version' (simply skipping
> any that don't parse) and use that to sort the tags.  If none parse with
> 'get-version' we could use the "no tags" error or have a separate error
> for "there were tags but we couldn't process them".
>
> And this lets us just do something like (untested):
>
> (define* (get-version tag #:key prefix suffix delim)
>   (define delim-rx (regexp-quote (or delim ".")))
>   (define prefix-rx (or prefix "[^[:digit:]]*"))
>   (define suffix-rx (or suffix ".*"))
>   (define version-char-rx
>    (string-append "[^" delim-rx "[:punct:]]"))
>
>   (define tag-rx
>    (string-append "^" prefix "(" version-char-rx "+("
>                   delim-rx version-char-rx ")*)" suffix-rx "$"))

This wouldn’t match anything if the version is just a plain number,
e.g., 1 or 09.

>
>   (and=> (string-match tag-rx tag)
>          (cut match-substring <> 1)))

With this, something like “1.4.0rc1-450-g2725ef99d” will result in
“1.4.0” being returned, which is incorrect.  Changing (cut
match:substring <> 1) to just ‘match:substring’ would solve the issue,
but then pre-release tags, which we usually don’t want,  would also get
matched.  Not sure what the best option would be in this case.

> Though at this point, 'tag-rx' should probably be constructed and
> compiled outside the loop.
>
>> +
>> +  (string-join no-delims "."))
>> +
>> +(define (sort-tags tags)
>> +  "Sort TAGS, a list if Git tags, such that the latest tag is the last element."
>> +  (sort tags (lambda (a b)
>> +               (eq? (version-compare a b) '<))))
>> +
>> +\f
>> +;;; Updater
>> +
>> +(define (get-remote url git-uri)
>> +  "Given a URL and GIT-URI, a <git-reference> record, return the ``origin'' remote."
>> +  (let* ((checkout (update-cached-checkout url
>> +                                           #:recursive?
>> +                                           (git-reference-recursive? git-uri)))
>> +         (repository (repository-open checkout)))
>> +    (remote-lookup repository "origin")))
>
> We surely don't want 'update-cached-checkout' since that fetches the
> whole repo history!  I've attached a patch below (based on top of this
> one) which brings the total time-per-package to under 1s.  I moved it to
> (guix git) to make use of 'with-libgit2' which ensures we use system
> certificates.
>
> Apologies for such a long reply. I hope it was helpful :)
>
> --
> Sarah
>
> From 0b0973034711e15b52702c0aec0c653dfd41928c Mon Sep 17 00:00:00 2001
> Message-Id: <0b0973034711e15b52702c0aec0c653dfd41928c.1630800771.git.iskarian@mgsn.dev>
> From: Sarah Morgensen <iskarian@mgsn.dev>
> Date: Fri, 3 Sep 2021 22:40:02 -0700
> Subject: [PATCH] git: Add 'ls-remote-refs'.
>
> ---
>  guix/git.scm        | 33 +++++++++++++++++++++++++++++++
>  guix/import/git.scm | 47 ++++++++++-----------------------------------
>  2 files changed, 43 insertions(+), 37 deletions(-)
>
> diff --git a/guix/git.scm b/guix/git.scm
> index 9c6f326c36..b784fd6d20 100644
> --- a/guix/git.scm
> +++ b/guix/git.scm
> @@ -56,6 +56,8 @@
>              commit-difference
>              commit-relation
>  
> +            ls-remote-refs
> +
>              git-checkout
>              git-checkout?
>              git-checkout-url
> @@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
>                (if (set-contains? oldest new)
>                    'descendant
>                    'unrelated))))))
> +\f
> +;;
> +;;; Remote operations.
> +;;;
> +
> +(define* (ls-remote-refs url #:key tags?)
> +  "Return the list of references advertised at Git repository URL.  If TAGS?
> +is true, limit to only refs/tags."
> +  (define (ref? ref)
> +    ;; Like `git ls-remote --refs', only show actual references.
> +    (and (string-prefix? "refs/" ref)
> +         (not (string-suffix? "^{}" ref))))
> +
> +  (define (tag? ref)
> +    (string-prefix? "refs/tags/" ref))
> +
> +  (define (include? ref)
> +    (and ref?
> +         (or (not tags?) (tag? ref))))
> +
> +  (with-libgit2
> +   (with-temporary-directory
> +    (lambda (cache-directory)
> +      (let* ((repository (repository-init cache-directory))
> +             ;; Create an in-memory remote so we don't touch disk.
> +             (remote (remote-create-anonymous repository url)))
> +        (remote-connect remote)
> +        (remote-disconnect remote)
> +        (repository-close! repository)
> +
> +        (filter include? (map remote-head-name (remote-ls remote))))))))
>

For some reason it seems to include refs that do and don’t end with
“^{}”

--8<---------------cut here---------------start------------->8---
scheme@(guile-user)> (ls-remote-refs "https://github.com/clementine-player/Clementine" #:tags? #t)
$6 = ("refs/tags/0.1" "refs/tags/0.1^{}" "refs/tags/0.2" "refs/tags/0.2^{}" "refs/tags/0.3" "refs/tags/0.3^{}" "refs/tags/0.3.1" "refs/tags/0.3.1^{}" "refs/tags/0.3.2" "refs/tags/0.3.2^{}" "refs/tags/0.3rc1" "refs/tags/0.3rc1^{}" "refs/tags/0.4" "refs/tags/0.4^{}" "refs/tags/0.4.1" "refs/tags/0.4.1^{}" "refs/tags/0.4.2" "refs/tags/0.4.2^{}" "refs/tags/0.4rc1" "refs/tags/0.4rc1^{}" "refs/tags/0.5" "refs/tags/0.5^{}" "refs/tags/0.5.1" "refs/tags/0.5.1^{}" "refs/tags/0.5.2" "refs/tags/0.5.2^{}" "refs/tags/0.5.3" "refs/tags/0.5.3^{}" "refs/tags/0.5rc1" "refs/tags/0.5rc1^{}" "refs/tags/0.6" "refs/tags/0.6^{}" "refs/tags/0.6rc1" "refs/tags/0.6rc1^{}" "refs/tags/0.7" "refs/tags/0.7^{}" "refs/tags/0.7.1" "refs/tags/0.7.1^{}" "refs/tags/0.7.2" "refs/tags/0.7.2^{}" "refs/tags/0.7.3" "refs/tags/0.7.3^{}" "refs/tags/0.7rc1" "refs/tags/0.7rc1^{}" "refs/tags/1.0" "refs/tags/1.0^{}" "refs/tags/1.0.1" "refs/tags/1.0.1^{}" "refs/tags/1.0rc1" "refs/tags/1.0rc1^{}" "refs/tags/1.1" "refs/tags/1.1^{}" "refs/tags/1.1.1" "refs/tags/1.1.1^{}" "refs/tags/1.2" "refs/tags/1.2^{}" "refs/tags/1.2.1" "refs/tags/1.2.1^{}" "refs/tags/1.2.2" "refs/tags/1.2.2^{}" "refs/tags/1.2.3" "refs/tags/1.2.3^{}" "refs/tags/1.3" "refs/tags/1.3.1" "refs/tags/1.3rc1" "refs/tags/1.4.0rc1" "refs/tags/1.4.0rc1^{}" "refs/tags/1.4.0rc1-153-g06ba55549" "refs/tags/1.4.0rc1-156-gca6f42fae" "refs/tags/1.4.0rc1-157-g176b1d6c7" "refs/tags/1.4.0rc1-163-gef3021dff" "refs/tags/1.4.0rc1-167-gb0c92ae78" "refs/tags/1.4.0rc1-168-g6285c11bc" "refs/tags/1.4.0rc1-169-g934fd336d" "refs/tags/1.4.0rc1-170-g509c65ced" "refs/tags/1.4.0rc1-171-g0ecb77335" "refs/tags/1.4.0rc1-172-gb007e54b3" "refs/tags/1.4.0rc1-174-gcb64d9705" "refs/tags/1.4.0rc1-176-g7e7d271b3" "refs/tags/1.4.0rc1-177-g096203ac8" "refs/tags/1.4.0rc1-188-g83fc376b0" "refs/tags/1.4.0rc1-189-g58569d9d0" "refs/tags/1.4.0rc1-194-gbaea2d488" "refs/tags/1.4.0rc1-198-g6a5cb0712" "refs/tags/1.4.0rc1-200-g18497dcb6" "refs/tags/1.4.0rc1-201-gf46241e75" "refs/tags/1.4.0rc1-202-g833f8256c" "refs/tags/1.4.0rc1-203-gbc1674700" "refs/tags/1.4.0rc1-204-g912589439" "refs/tags/1.4.0rc1-206-g8f56fbb83" "refs/tags/1.4.0rc1-207-g879dfa3d7" "refs/tags/1.4.0rc1-211-g949c20abd" "refs/tags/1.4.0rc1-230-gc934fef63" "refs/tags/1.4.0rc1-231-g60a46d193" "refs/tags/1.4.0rc1-234-g0271f43cc" "refs/tags/1.4.0rc1-235-g92b160d2a" "refs/tags/1.4.0rc1-236-g13ee11f81" "refs/tags/1.4.0rc1-237-g54f200d9b" "refs/tags/1.4.0rc1-239-gfa067bf5c" "refs/tags/1.4.0rc1-241-ge7c5c76ea" "refs/tags/1.4.0rc1-242-gcf1067e74" "refs/tags/1.4.0rc1-243-g5612c9cb5" "refs/tags/1.4.0rc1-244-g84099f249" "refs/tags/1.4.0rc1-245-g0555cf5a3" "refs/tags/1.4.0rc1-246-gf90babefa" "refs/tags/1.4.0rc1-247-g1a73918f9" "refs/tags/1.4.0rc1-248-ged0078b8d" "refs/tags/1.4.0rc1-250-ga63a37a7a" "refs/tags/1.4.0rc1-251-g6f5fe724b" "refs/tags/1.4.0rc1-252-gc8d56776a" "refs/tags/1.4.0rc1-253-g00f9597d3" "refs/tags/1.4.0rc1-254-gbf3d3db23" "refs/tags/1.4.0rc1-257-g236cfa7ad" "refs/tags/1.4.0rc1-258-g84fc00d55" "refs/tags/1.4.0rc1-261-g48ae27b4a" "refs/tags/1.4.0rc1-262-g536f34526" "refs/tags/1.4.0rc1-263-g4c9241db1" "refs/tags/1.4.0rc1-264-g22537a450" "refs/tags/1.4.0rc1-265-g22cfade4a" "refs/tags/1.4.0rc1-268-gc299c198d" "refs/tags/1.4.0rc1-269-gcf8d2004b" "refs/tags/1.4.0rc1-270-g6900197a8" "refs/tags/1.4.0rc1-271-g56ed6d4f7" "refs/tags/1.4.0rc1-272-gedb8c3b4e" "refs/tags/1.4.0rc1-274-g1ef5ec259" "refs/tags/1.4.0rc1-275-g0d25a1b39" "refs/tags/1.4.0rc1-276-g8c25c443c" "refs/tags/1.4.0rc1-279-g76a24a0a2" "refs/tags/1.4.0rc1-280-gcf279e6f4" "refs/tags/1.4.0rc1-282-gad882cc99" "refs/tags/1.4.0rc1-283-g0fcb1df20" "refs/tags/1.4.0rc1-284-g7d28e8700" "refs/tags/1.4.0rc1-285-gebf9ebf08" "refs/tags/1.4.0rc1-289-g834b1d451" "refs/tags/1.4.0rc1-290-g3bfaf3ff3" "refs/tags/1.4.0rc1-291-gc75fa0077" "refs/tags/1.4.0rc1-292-gdd9ed2334" "refs/tags/1.4.0rc1-293-g1f7607b1d" "refs/tags/1.4.0rc1-294-g987fe047c" "refs/tags/1.4.0rc1-295-gee72793b5" "refs/tags/1.4.0rc1-296-g68d375c43" "refs/tags/1.4.0rc1-310-gd131c66f0" "refs/tags/1.4.0rc1-315-g16843da41" "refs/tags/1.4.0rc1-318-g44af6f9d5" "refs/tags/1.4.0rc1-319-gd3e327022" "refs/tags/1.4.0rc1-320-g3a4d7f3a3" "refs/tags/1.4.0rc1-321-g2d280734a" "refs/tags/1.4.0rc1-322-g6821f6d7b" "refs/tags/1.4.0rc1-323-g29aad2ae3" "refs/tags/1.4.0rc1-324-g06855ea6c" "refs/tags/1.4.0rc1-325-g598f84007" "refs/tags/1.4.0rc1-326-gd0bf92f06" "refs/tags/1.4.0rc1-327-g7b3a0f397" "refs/tags/1.4.0rc1-328-ge9b62fa34" "refs/tags/1.4.0rc1-329-gf7bece3b8" "refs/tags/1.4.0rc1-332-g62d2f0de9" "refs/tags/1.4.0rc1-340-g2172732b1" "refs/tags/1.4.0rc1-341-g54f7637ad" "refs/tags/1.4.0rc1-342-g2bac3626c" "refs/tags/1.4.0rc1-343-gb49afcc5b" "refs/tags/1.4.0rc1-344-gad354276b" "refs/tags/1.4.0rc1-345-g9e8d4434a" "refs/tags/1.4.0rc1-346-g4e3e9c8d1" "refs/tags/1.4.0rc1-347-gfc4cb6fc7" "refs/tags/1.4.0rc1-348-gcac606186" "refs/tags/1.4.0rc1-349-g16d09ace0" "refs/tags/1.4.0rc1-350-geefb96bdc" "refs/tags/1.4.0rc1-351-g1daf43f91" "refs/tags/1.4.0rc1-352-gaaee0b701" "refs/tags/1.4.0rc1-353-gae4948ce3" "refs/tags/1.4.0rc1-354-gd970b7400" "refs/tags/1.4.0rc1-355-gc856a6617" "refs/tags/1.4.0rc1-356-gd417aed29" "refs/tags/1.4.0rc1-357-geec7641ef" "refs/tags/1.4.0rc1-358-gc536dc88e" "refs/tags/1.4.0rc1-360-gb2044a5be" "refs/tags/1.4.0rc1-361-gf17e29f41" "refs/tags/1.4.0rc1-362-g7b3e2dfd8" "refs/tags/1.4.0rc1-363-gf60c42224" "refs/tags/1.4.0rc1-364-gc4d22d441" "refs/tags/1.4.0rc1-365-g41b1ba8ff" "refs/tags/1.4.0rc1-366-g20f49c445" "refs/tags/1.4.0rc1-368-g1a0b288a8" "refs/tags/1.4.0rc1-369-gf5c904b26" "refs/tags/1.4.0rc1-370-gcca48b1eb" "refs/tags/1.4.0rc1-371-gdf262c5c7" "refs/tags/1.4.0rc1-372-g01f072764" "refs/tags/1.4.0rc1-373-gba8fc09a6" "refs/tags/1.4.0rc1-374-g91bad31f6" "refs/tags/1.4.0rc1-377-gccba649f6" "refs/tags/1.4.0rc1-378-ga3a51ae11" "refs/tags/1.4.0rc1-379-gcfcd0a956" "refs/tags/1.4.0rc1-380-gd7966c828" "refs/tags/1.4.0rc1-384-g41513527c" "refs/tags/1.4.0rc1-386-gbbb6a773f" "refs/tags/1.4.0rc1-387-g627ddc398" "refs/tags/1.4.0rc1-388-g6a6ef729e" "refs/tags/1.4.0rc1-389-g51c600a53" "refs/tags/1.4.0rc1-390-gaf4810a58" "refs/tags/1.4.0rc1-391-g863a66824" "refs/tags/1.4.0rc1-392-g9f8093a22" "refs/tags/1.4.0rc1-393-gc999fc70e" "refs/tags/1.4.0rc1-394-g870969ef4" "refs/tags/1.4.0rc1-395-gfaab7fa6c" "refs/tags/1.4.0rc1-396-g549544517" "refs/tags/1.4.0rc1-397-g616ccc6fd" "refs/tags/1.4.0rc1-398-g0393d865c" "refs/tags/1.4.0rc1-399-ga012e7e27" "refs/tags/1.4.0rc1-400-g87cd3d2ab" "refs/tags/1.4.0rc1-401-gdc2c1e111" "refs/tags/1.4.0rc1-402-g63a73a4a5" "refs/tags/1.4.0rc1-403-g2b99d32be" "refs/tags/1.4.0rc1-406-g409c6b89d" "refs/tags/1.4.0rc1-407-g3efa68f07" "refs/tags/1.4.0rc1-408-g8f863bc96" "refs/tags/1.4.0rc1-409-g8201c1035" "refs/tags/1.4.0rc1-410-g479f1d4de" "refs/tags/1.4.0rc1-413-g25d3fca07" "refs/tags/1.4.0rc1-414-g8c774e388" "refs/tags/1.4.0rc1-416-g7b9430982" "refs/tags/1.4.0rc1-417-gf779652aa" "refs/tags/1.4.0rc1-418-gb3aed042e" "refs/tags/1.4.0rc1-420-g596cd9b0a" "refs/tags/1.4.0rc1-421-ge1e559732" "refs/tags/1.4.0rc1-422-gace5234e6" "refs/tags/1.4.0rc1-423-g2dd424a19" "refs/tags/1.4.0rc1-425-g4f5bf1cc6" "refs/tags/1.4.0rc1-426-g72e2e62eb" "refs/tags/1.4.0rc1-427-gcf842a8c5" "refs/tags/1.4.0rc1-428-g81a3c0f83" "refs/tags/1.4.0rc1-429-gf1678fd33" "refs/tags/1.4.0rc1-430-g7854aefdd" "refs/tags/1.4.0rc1-431-ga9e193234" "refs/tags/1.4.0rc1-432-g447e91a68" "refs/tags/1.4.0rc1-433-g76c87146d" "refs/tags/1.4.0rc1-434-ga7a32b08b" "refs/tags/1.4.0rc1-436-g8c2ab8fa0" "refs/tags/1.4.0rc1-438-gcb88954a3" "refs/tags/1.4.0rc1-439-g79ca9147e" "refs/tags/1.4.0rc1-440-g7ba322b10" "refs/tags/1.4.0rc1-441-gb9a844263" "refs/tags/1.4.0rc1-442-g78d4c4f3f" "refs/tags/1.4.0rc1-444-g8d11e9ffa" "refs/tags/1.4.0rc1-446-g18eef830a" "refs/tags/1.4.0rc1-447-g8db8b1e78" "refs/tags/1.4.0rc1-448-g816fd88d4" "refs/tags/1.4.0rc1-449-g50ee78613" "refs/tags/1.4.0rc1-450-g2725ef99d" "refs/tags/1.4.0rc1-451-g66ea25bca" "refs/tags/1.4.0rc1-453-g281da0532" "refs/tags/1.4.0rc1-454-g57a6fe4f2" "refs/tags/1.4.0rc1-456-geb7a9bfa4" "refs/tags/1.4.0rc1-457-g8f3772b59" "refs/tags/1.4.0rc1-459-ge84f87f62" "refs/tags/1.4.0rc1-461-gf7b6708e4" "refs/tags/1.4.0rc1-462-gfffc50c79" "refs/tags/1.4.0rc1-463-gf7ed4a309" "refs/tags/1.4.0rc1-464-gcde0343a6" "refs/tags/1.4.0rc1-465-gb69dd2d90" "refs/tags/1.4.0rc1-466-gd9a48b90b" "refs/tags/1.4.0rc1-467-gd93bd9ca2" "refs/tags/1.4.0rc1-468-g1a3828e2c" "refs/tags/1.4.0rc1-469-gb40d9ed44" "refs/tags/1.4.0rc1-471-gb989a674a" "refs/tags/1.4.0rc1-472-g4e8a12f37" "refs/tags/1.4.0rc1-473-gbce55d0ef" "refs/tags/1.4.0rc1-477-g576731767" "refs/tags/1.4.0rc1-480-g05f513ab6" "refs/tags/1.4.0rc1-481-g2b988ed7b" "refs/tags/1.4.0rc1-482-g0c099ab6f" "refs/tags/1.4.0rc1-483-gc7f5c0f40" "refs/tags/1.4.0rc1-484-g2d8a56b7c" "refs/tags/1.4.0rc1-486-gf92690c14" "refs/tags/1.4.0rc1-487-g15474ada3" "refs/tags/1.4.0rc1-488-g7bb0c59f2" "refs/tags/1.4.0rc1-489-g6314c8cb2" "refs/tags/1.4.0rc1-491-g651eee13e" "refs/tags/1.4.0rc1-494-gdfb953a78" "refs/tags/1.4.0rc1-495-g10bf5dc17" "refs/tags/1.4.0rc1-496-gcef1d7e74" "refs/tags/1.4.0rc1-497-g3bd15aea0" "refs/tags/1.4.0rc1-498-g681e7bea5" "refs/tags/1.4.0rc1-502-gaf75ebbd6" "refs/tags/1.4.0rc1-509-g89e9b20df" "refs/tags/1.4.0rc1-510-g3f34b332c" "refs/tags/1.4.0rc1-512-g8b2f7f08a" "refs/tags/1.4.0rc1-514-g05e450c3c" "refs/tags/1.4.0rc1-515-g1154c0f54" "refs/tags/1.4.0rc1-516-g8b566b2a7" "refs/tags/1.4.0rc1-518-g3244cf083" "refs/tags/1.4.0rc1-519-gd1e9ee9f9" "refs/tags/1.4.0rc1-520-gc394d7d2d" "refs/tags/1.4.0rc1-521-gb68b12010" "refs/tags/1.4.0rc1-522-gfdb3f7ac3" "refs/tags/1.4.0rc1-525-gc12294c5e" "refs/tags/1.4.0rc1-526-g881898f84" "refs/tags/1.4.0rc1-527-g438e8ca61" "refs/tags/1.4.0rc1-528-g86d782cb6" "refs/tags/1.4.0rc1-531-g641279072" "refs/tags/1.4.0rc1-533-gf4e70face" "refs/tags/1.4.0rc1-534-gd13410c91" "refs/tags/1.4.0rc1-536-g4edf77082" "refs/tags/1.4.0rc1-537-gada6752ea" "refs/tags/1.4.0rc1-538-g15fdad3d5" "refs/tags/1.4.0rc1-540-g4f86e0b2b" "refs/tags/1.4.0rc1-541-ge077df22d" "refs/tags/1.4.0rc1-542-g8a7120e1e" "refs/tags/1.4.0rc1-544-g3b8519fda" "refs/tags/1.4.0rc1-545-g2d6bb4abd" "refs/tags/1.4.0rc1-548-g354f6a23e" "refs/tags/1.4.0rc1-549-ge8875faf8" "refs/tags/1.4.0rc1-550-g72c1f91c0" "refs/tags/1.4.0rc1-551-g144bdc249" "refs/tags/1.4.0rc1-552-gdb55c541b" "refs/tags/1.4.0rc1-553-ga86558f9a" "refs/tags/1.4.0rc1-554-g2d34588b8" "refs/tags/1.4.0rc1-555-g32944a15d" "refs/tags/1.4.0rc1-556-g3440f90a6" "refs/tags/1.4.0rc1-557-g009642d12" "refs/tags/1.4.0rc1-558-g47f7b307f" "refs/tags/1.4.0rc1-559-ge7364263b" "refs/tags/1.4.0rc1-560-g7303f72ee" "refs/tags/1.4.0rc1-562-g99ee1394a" "refs/tags/1.4.0rc1-563-g163ebe71d" "refs/tags/1.4.0rc1-564-g429d8ee0f" "refs/tags/1.4.0rc1-565-g6b21079fd" "refs/tags/1.4.0rc1-566-gf04657e7e" "refs/tags/1.4.0rc1-567-g280a514eb" "refs/tags/1.4.0rc1-568-gc51d2f954" "refs/tags/1.4.0rc1-569-gf17b79a10" "refs/tags/1.4.0rc1-570-g73c0af197" "refs/tags/1.4.0rc1-571-g5f75bde39" "refs/tags/1.4.0rc1-572-g59f6d95b8" "refs/tags/1.4.0rc1-573-g8258c78c0" "refs/tags/1.4.0rc1-574-gb2ed9499f" "refs/tags/1.4.0rc1-575-g94f4f65a6" "refs/tags/1.4.0rc1-576-g7e48b78c1" "refs/tags/1.4.0rc1-577-gfc83e4127" "refs/tags/1.4.0rc1-578-gd59ed1e70" "refs/tags/1.4.0rc1-579-g8fddc816a" "refs/tags/1.4.0rc1-585-g8c1bdc1a4" "refs/tags/1.4.0rc1-586-g20647e8a9" "refs/tags/1.4.0rc1-587-g708385c71" "refs/tags/1.4.0rc1-588-g9a337a9ef" "refs/tags/1.4.0rc1-589-gf48888a43" "refs/tags/1.4.0rc1-591-g579d86904" "refs/tags/1.4.0rc1-593-g783213f9c" "refs/tags/1.4.0rc1-594-gf5d3079db" "refs/tags/1.4.0rc1-596-g590bcf1c7" "refs/tags/1.4.0rc1-597-g83157100c" "refs/tags/1.4.0rc1-598-gd16d9ba28" "refs/tags/1.4.0rc1-600-g3f614464e" "refs/tags/1.4.0rc1-601-ga7468dcd4" "refs/tags/1.4.0rc1-602-g89155ace7" "refs/tags/1.4.0rc1-603-g75de59703" "refs/tags/1.4.0rc1-604-g1309c76be" "refs/tags/1.4.0rc1-613-ge756f2d68" "refs/tags/1.4.0rc1-614-g89831f8dc" "refs/tags/1.4.0rc1-617-g776bd3b02" "refs/tags/1.4.0rc1-618-gf071075e8" "refs/tags/1.4.0rc1-619-gd71eba97f" "refs/tags/1.4.0rc1-620-g684c9d232" "refs/tags/1.4.0rc1-621-g2132e99fb" "refs/tags/1.4.0rc1-622-gf7369d2c4" "refs/tags/1.4.0rc1-623-gf67475375" "refs/tags/1.4.0rc1-624-g72cfdf25a" "refs/tags/1.4.0rc1-626-g058fe6f4b" "refs/tags/1.4.0rc1-627-g0dbefa306" "refs/tags/1.4.0rc1-628-gb09ab3ff3" "refs/tags/1.4.0rc1-629-g612767c87" "refs/tags/1.4.0rc1-631-g4e4fccc07" "refs/tags/1.4.0rc1-633-g3a00403ad" "refs/tags/1.4.0rc1-634-g4aa4f4fce" "refs/tags/1.4.0rc1-635-g418a36693" "refs/tags/1.4.0rc1-636-g2bf8f1388" "refs/tags/1.4.0rc1-637-gffdaeba09" "refs/tags/1.4.0rc1-638-gc3c77aef1" "refs/tags/1.4.0rc1-639-g11bd0db03" "refs/tags/1.4.0rc1-657-g57b5911f1" "refs/tags/1.4.0rc1-658-g6240fd3d0" "refs/tags/1.4.0rc1-659-g54be35f52" "refs/tags/1.4.0rc1-660-ge46503d0c" "refs/tags/1.4.0rc1-661-g62cb889a3" "refs/tags/1.4.0rc1-662-g5ab81fd8b" "refs/tags/1.4.0rc1-663-gf9854e564" "refs/tags/1.4.0rc1-664-g1db1e3231" "refs/tags/1.4.0rc1-665-g67a947f11" "refs/tags/1.4.0rc1-666-g4a83f8c81" "refs/tags/1.4.0rc1-668-gf35a640ce" "refs/tags/1.4.0rc1-669-g67aa15418" "refs/tags/1.4.0rc1-670-g8c660e278" "refs/tags/1.4.0rc1-671-g25b537cf2" "refs/tags/1.4.0rc1-672-ga5fd484a6" "refs/tags/1.4.0rc1-673-gdb8de64ab" "refs/tags/1.4.0rc1-674-g7cb5f5c80" "refs/tags/1.4.0rc1-675-ga5e84bbe9" "refs/tags/1.4.0rc1-676-g6b2918ee9" "refs/tags/1.4.0rc1-677-g4acfdae74" "refs/tags/1.4.0rc1-678-g2902a8786" "refs/tags/1.4.0rc1-679-gb3b769f0e" "refs/tags/1.4.0rc1-680-g4d3474840" "refs/tags/1.4.0rc1-681-g598e660ae" "refs/tags/1.4.0rc1-682-g0c1b6a2a4" "refs/tags/1.4.0rc1-683-g320a1b81c" "refs/tags/1.4.0rc1-684-g1d1d3b157" "refs/tags/1.4.0rc1-685-gf379ad84d" "refs/tags/1.4.0rc1-686-gdaa2f25e3" "refs/tags/1.4.0rc1-687-g1e39ce29a" "refs/tags/1.4.0rc1-688-g98dd3e48a" "refs/tags/1.4.0rc1-689-g6982b4781" "refs/tags/1.4.0rc1-690-gc0c903767" "refs/tags/1.4.0rc1-691-gdbe15e5e9" "refs/tags/1.4.0rc1-692-g224c475b5" "refs/tags/1.4.0rc1-693-gac3a0d33f" "refs/tags/1.4.0rc1-694-g102317e5c" "refs/tags/1.4.0rc1-695-ge2d6759d5" "refs/tags/1.4.0rc1-696-gbf424ce98" "refs/tags/1.4.0rc1-697-gcddc08e14" "refs/tags/1.4.0rc1-698-gb55e54388" "refs/tags/1.4.0rc1-699-g327d5fdac" "refs/tags/1.4.0rc1-700-g03e13c69e" "refs/tags/1.4.0rc1-701-g8682d4de4" "refs/tags/1.4.0rc1-702-g922afe506" "refs/tags/1.4.0rc1-708-gc8c110efa" "refs/tags/1.4.0rc1-709-g628ff6582" "refs/tags/1.4.0rc1-710-g7eb62b626" "refs/tags/1.4.0rc1-711-g3b7d5880f" "refs/tags/1.4.0rc1-712-g769d8bbe6" "refs/tags/1.4.0rc1-713-gc58335c6c" "refs/tags/1.4.0rc1-715-ge556a59ae" "refs/tags/1.4.0rc1-716-g2cca75d93")
scheme@(guile-user)>
--8<---------------cut here---------------end--------------->8---

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-05 13:11   ` Xinglu Chen
@ 2021-09-06  3:14     ` Sarah Morgensen
  0 siblings, 0 replies; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-06  3:14 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359

Hello,

Xinglu Chen <public@yoctocell.xyz> writes:

>> And this lets us just do something like (untested):
>>
>> (define* (get-version tag #:key prefix suffix delim)
>>   (define delim-rx (regexp-quote (or delim ".")))
>>   (define prefix-rx (or prefix "[^[:digit:]]*"))
>>   (define suffix-rx (or suffix ".*"))
>>   (define version-char-rx
>>    (string-append "[^" delim-rx "[:punct:]]"))
>>
>>   (define tag-rx
>>    (string-append "^" prefix "(" version-char-rx "+("
>>                   delim-rx version-char-rx ")*)" suffix-rx "$"))
>
> This wouldn’t match anything if the version is just a plain number,
> e.g., 1 or 09.

It does, but I had many errors in the definition.  Again, apologies.  I
shouldn't send emails that late, haha.  This method should read:

 --8<---------------cut here---------------start------------->8---
 (define* (get-version tag #:key prefix suffix delim)
   (define delim-rx (regexp-quote (or delim ".")))
   (define prefix-rx (or prefix "[^[:digit:]]*"))
   (define suffix-rx (or suffix ".*"))
   (define version-char-rx
    (string-append "[^" delim-rx "[:punct:]]"))

   (define tag-rx
    (string-append "^" prefix-rx "(" version-char-rx "+("
                   delim-rx version-char-rx "+)*)" suffix-rx "$"))
   (and=> (string-match tag-rx tag)
          (cut match:substring <> 1)))
--8<---------------cut here---------------end--------------->8---

>
> With this, something like “1.4.0rc1-450-g2725ef99d” will result in
> “1.4.0” being returned, which is incorrect.  Changing (cut
> match:substring <> 1) to just ‘match:substring’ would solve the issue,
> but then pre-release tags, which we usually don’t want,  would also get
> matched.  Not sure what the best option would be in this case.
>

With the fixed method above:

scheme@(emacs-guix)> (get-version "8")
$16 = "8"
scheme@(emacs-guix)> (get-version "1.4.0rc1-450-g2725ef99d")
$17 = "1.4.0rc1"

But, we still get:

scheme@(emacs-guix)> (get-version "1.4.0-rc1")
$18 = "1.4.0"

which leads us to what you talked about in your other message.

[...]
>> +(define* (ls-remote-refs url #:key tags?)
>> +  "Return the list of references advertised at Git repository URL.  If TAGS?
>> +is true, limit to only refs/tags."
>> +  (define (ref? ref)
>> +    ;; Like `git ls-remote --refs', only show actual references.
>> +    (and (string-prefix? "refs/" ref)
>> +         (not (string-suffix? "^{}" ref))))
>> +
>> +  (define (tag? ref)
>> +    (string-prefix? "refs/tags/" ref))
>> +
>> +  (define (include? ref)
>> +    (and ref?

This should be:
        (and (ref? ref)

>> +         (or (not tags?) (tag? ref))))
>> +
>> +  (with-libgit2
>> +   (with-temporary-directory
>> +    (lambda (cache-directory)
>> +      (let* ((repository (repository-init cache-directory))
>> +             ;; Create an in-memory remote so we don't touch disk.
>> +             (remote (remote-create-anonymous repository url)))
>> +        (remote-connect remote)
>> +        (remote-disconnect remote)
>> +        (repository-close! repository)
>> +
>> +        (filter include? (map remote-head-name (remote-ls remote))))))))
>>
>
> For some reason it seems to include refs that do and don’t end with
> “^{}”

Sorry, another typo I missed.  See above.

--
Sarah




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-05 10:36   ` Xinglu Chen
@ 2021-09-06  5:40     ` Sarah Morgensen
  2021-09-06 12:20       ` Xinglu Chen
  0 siblings, 1 reply; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-06  5:40 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 2363 bytes --]

Hi,

Xinglu Chen <public@yoctocell.xyz> writes:

>> There are about 50-60 packages like this.
>>
>> I'm not sure how much effort should be spent including them, and for
>> some of them I'm not sure what our ideal behavior *is*.  Even if we
>> could reliably detect them, should "alpha" or "dev" packages be returned
>> by the updater?
>
> I don’t think we usually include alpha or rc releases, so updater
> probably shouldn’t return them either.  Not sure how we would try to
> detect alpha/beta/rc releases, though, besides running something like
>
>   (string-match? "(alpha|beta|rc|dev)" TAG)
>
> On each tag.

That heuristic is pretty good.  (It might miss a few, but I'd rather
accidentally include some alpha/beta/rc releases than risk excluding
real ones.)

We could then safely sort tags with just the prefix removed -- this takes care
of "1.1f" coming after "1.1", and so on.

Actually, it looks like there's only a few packages with a suffix;
instead, we can probably just only use a suffix if they provide
'tag-suffix.  This is all of them (and the "dev" ones probably shouldn't
be suffixes, just part of the version):

(commit (string-append "v" version "-stable"))))
(commit (string-append version "-stable"))))
(commit (string-append version "-Leia"))))
(commit (string-append "haddock-" version "-release"))))
(commit (string-append "v" version "-8.13"))))
(commit (string-append "v" version "-oss"))))
(commit (string-append "v" version "-stable"))))
(commit (string-append "ddskk-" version "_" code-name))))
(commit (string-append version "-freebsdport"))))
(commit (string-append version "-dev"))))
(commit (string-append version "-release-20210531143054"))))
(commit (string-append version "-release-20210412001032"))))
(commit (string-append "v" version "-debian"))))
(commit (string-append version "dev"))))
(commit (string-append version "_Linux"))
(commit (string-append version "R"))))
(commit (string-append "jdk-" version "-ga"))))
(commit (string-append "jdk-" version "-ga"))))
(commit (string-append "jdk-" version "-ga"))))
(commit (string-append "jdk-" version "-ga"))))
(commit (string-append version "-opt"))))
(commit (string-append "1.1-" version "-RELEASE"))))

Additionally, these are all the weird version strings I could find that
are actually used as the commit:

[-- Attachment #2: versions --]
[-- Type: text/plain, Size: 1416 bytes --]

1.2.2.rc2
12-068oasis4
1.2-2
0.F-2
0.2.0-alpha
5.1.0-b2
1.5-11
1.9.14-20210407
0.9.3b
2.8-fix-2
2020-05-19
10-11.0.0
1.0.12-2
0.9.3+16.04.20160218-0ubuntu1
2.12.c
1.1+11
5.1+4.06.0
4.2-411
1.4.0rc1-450-g2725ef99d
2.0.0-alpha14
60.2.3-2
1.21c
1.0.0rc4
2.1.0b1
1.02r6
0.32-14-gcdfe14e
3.0.0a3
2.00a2.3
1.0beta.18
2.1b
2.7.8a
2.7.3a
1.1.alpha19
1.0.2-rc4
0.5.3+git20200502
1.0.3-rc3
4.0.0.dev8
3.0.0beta1-24-g024cc9fa2
0.16-2-ge145396
2.0b6
2.0M10
1.0.7+0
1.16.0+5
0.4.0+1
2.2.10+0
4.3.1+2
2.13.93+0
2.10.4+0
1.0.5+5
0.21.0+0
3.3.4+0
2.68.1+0
0.10.1+1
6.9.10-12+3
2.0.1+2
3.100.0+1
0.14.0+2
0.1.6+2
3.3.0+0
1.8.7+0
1.3.0+2
1.42.0+0
1.16.1+0
2.35.0+0
1.6.37+5
4.1.0+1
2.36.0+0
1.3.6+4
2.10.1+0
2.26.0+0
1.3.4+0
1.1.1+2
1.3.1+1
8.44.0+0
0.40.1+0
5.15.2+0
1.17.0+3
1.18.0+3
2020.7.14+0
3.0.0+1
0.9.1+3
2.9.12+0
0.1.0+2
1.6.9+2
1.0.9+3
1.13.0+2
1.2.0+3
1.1.3+3
1.3.4+2
5.0.3+3
1.7.10+3
1.1.4+3
1.1.0+3
1.5.2+3
0.9.10+3
0.4.0+1
0.4.0+1
0.4.0+1
0.3.9+1
0.4.1+1
1.4.2+3
2.27.0+3
1.4.0+2
1.1.34+0
1.2.12+1
1.5.0+0
2021-06-07
1.2.2-5-g20dc8ed
2.1-20201229
3.0-rc1
1.32.0-0
20200701.154658.b0d6223
3.9-0
R63-10032.B
0.58.2.a
0.0.0+git20200527
3.028R
3.001R
2.57b
1.0.0-20201130134442-10cb98267c6c
0.0.0-20161123171359-e6a2ba005892
0.0.0-20210615171337-6886f2dfbf5b
2020-11-10
5.2.0-alpha
2021-01-01
2021-02-28
2020-11-01
4.4-git.1
1.217-2
3.3.06-1
0.2.0-alpha-199-g3e7a475
1.0.0-beta.0
1.20190621-4
1.9.0-147-g61edec1ef
0.0.9.4f

[-- Attachment #3: Type: text/plain, Size: 754 bytes --]


Yep, it looks like the above would work for the majority of these.
That's probably Good Enough^tm.

>>> +  (define no-delims
>>> +    (if (string-match delim-regexp no-suffix)
>>> +        (string-split* no-suffix delim*)
>>> +        (git-tag-error 'tag-version-delimiter)))
>>
>> This throws an error if the version doesn't have any delimiter.
>
> Setting the ‘tag-version-delimiter’ prefix to an empty string would
> solve this, right?  Or, maybe we should just get rid of the delimiter
> thing since only a few packages use a different delimiter.

IMO, just get rid of the delimiter.  If we wanted to be *that* flexible,
we could make it so they provide a tag->version proc instead of (prefix,
suffix, delimiter).

--
Sarah

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-06  5:40     ` Sarah Morgensen
@ 2021-09-06 12:20       ` Xinglu Chen
  2021-09-07  1:00         ` Sarah Morgensen
  0 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-06 12:20 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 9944 bytes --]

On Sun, Sep 05 2021, Sarah Morgensen wrote:

> Hi,
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>>> There are about 50-60 packages like this.
>>>
>>> I'm not sure how much effort should be spent including them, and for
>>> some of them I'm not sure what our ideal behavior *is*.  Even if we
>>> could reliably detect them, should "alpha" or "dev" packages be returned
>>> by the updater?
>>
>> I don’t think we usually include alpha or rc releases, so updater
>> probably shouldn’t return them either.  Not sure how we would try to
>> detect alpha/beta/rc releases, though, besides running something like
>>
>>   (string-match? "(alpha|beta|rc|dev)" TAG)
>>
>> On each tag.
>
> That heuristic is pretty good.  (It might miss a few, but I'd rather
> accidentally include some alpha/beta/rc releases than risk excluding
> real ones.)
>
> We could then safely sort tags with just the prefix removed -- this takes care
> of "1.1f" coming after "1.1", and so on.
>
> Actually, it looks like there's only a few packages with a suffix;
> instead, we can probably just only use a suffix if they provide
> 'tag-suffix.  This is all of them (and the "dev" ones probably shouldn't
> be suffixes, just part of the version):

Yeah, I think that sounds like a reasonable thing to do.

> (commit (string-append "v" version "-stable"))))
> (commit (string-append version "-stable"))))
> (commit (string-append version "-Leia"))))
> (commit (string-append "haddock-" version "-release"))))
> (commit (string-append "v" version "-8.13"))))
> (commit (string-append "v" version "-oss"))))
> (commit (string-append "v" version "-stable"))))
> (commit (string-append "ddskk-" version "_" code-name))))
> (commit (string-append version "-freebsdport"))))
> (commit (string-append version "-dev"))))
> (commit (string-append version "-release-20210531143054"))))
> (commit (string-append version "-release-20210412001032"))))
> (commit (string-append "v" version "-debian"))))
> (commit (string-append version "dev"))))
> (commit (string-append version "_Linux"))
> (commit (string-append version "R"))))
> (commit (string-append "jdk-" version "-ga"))))
> (commit (string-append "jdk-" version "-ga"))))
> (commit (string-append "jdk-" version "-ga"))))
> (commit (string-append "jdk-" version "-ga"))))
> (commit (string-append version "-opt"))))
> (commit (string-append "1.1-" version "-RELEASE"))))
>
> Additionally, these are all the weird version strings I could find that
> are actually used as the commit:
> 1.2.2.rc2
> 12-068oasis4
> 1.2-2
> 0.F-2
> 0.2.0-alpha
> 5.1.0-b2
> 1.5-11
> 1.9.14-20210407
> 0.9.3b
> 2.8-fix-2
> 2020-05-19
> 10-11.0.0
> 1.0.12-2
> 0.9.3+16.04.20160218-0ubuntu1
> 2.12.c
> 1.1+11
> 5.1+4.06.0
> 4.2-411
> 1.4.0rc1-450-g2725ef99d
> 2.0.0-alpha14
> 60.2.3-2
> 1.21c
> 1.0.0rc4
> 2.1.0b1
> 1.02r6
> 0.32-14-gcdfe14e
> 3.0.0a3
> 2.00a2.3
> 1.0beta.18
> 2.1b
> 2.7.8a
> 2.7.3a
> 1.1.alpha19
> 1.0.2-rc4
> 0.5.3+git20200502
> 1.0.3-rc3
> 4.0.0.dev8
> 3.0.0beta1-24-g024cc9fa2
> 0.16-2-ge145396
> 2.0b6
> 2.0M10
> 1.0.7+0
> 1.16.0+5
> 0.4.0+1
> 2.2.10+0
> 4.3.1+2
> 2.13.93+0
> 2.10.4+0
> 1.0.5+5
> 0.21.0+0
> 3.3.4+0
> 2.68.1+0
> 0.10.1+1
> 6.9.10-12+3
> 2.0.1+2
> 3.100.0+1
> 0.14.0+2
> 0.1.6+2
> 3.3.0+0
> 1.8.7+0
> 1.3.0+2
> 1.42.0+0
> 1.16.1+0
> 2.35.0+0
> 1.6.37+5
> 4.1.0+1
> 2.36.0+0
> 1.3.6+4
> 2.10.1+0
> 2.26.0+0
> 1.3.4+0
> 1.1.1+2
> 1.3.1+1
> 8.44.0+0
> 0.40.1+0
> 5.15.2+0
> 1.17.0+3
> 1.18.0+3
> 2020.7.14+0
> 3.0.0+1
> 0.9.1+3
> 2.9.12+0
> 0.1.0+2
> 1.6.9+2
> 1.0.9+3
> 1.13.0+2
> 1.2.0+3
> 1.1.3+3
> 1.3.4+2
> 5.0.3+3
> 1.7.10+3
> 1.1.4+3
> 1.1.0+3
> 1.5.2+3
> 0.9.10+3
> 0.4.0+1
> 0.4.0+1
> 0.4.0+1
> 0.3.9+1
> 0.4.1+1
> 1.4.2+3
> 2.27.0+3
> 1.4.0+2
> 1.1.34+0
> 1.2.12+1
> 1.5.0+0
> 2021-06-07
> 1.2.2-5-g20dc8ed
> 2.1-20201229
> 3.0-rc1
> 1.32.0-0
> 20200701.154658.b0d6223
> 3.9-0
> R63-10032.B
> 0.58.2.a
> 0.0.0+git20200527
> 3.028R
> 3.001R
> 2.57b
> 1.0.0-20201130134442-10cb98267c6c
> 0.0.0-20161123171359-e6a2ba005892
> 0.0.0-20210615171337-6886f2dfbf5b
> 2020-11-10
> 5.2.0-alpha
> 2021-01-01
> 2021-02-28
> 2020-11-01
> 4.4-git.1
> 1.217-2
> 3.3.06-1
> 0.2.0-alpha-199-g3e7a475
> 1.0.0-beta.0
> 1.20190621-4
> 1.9.0-147-g61edec1ef
> 0.0.9.4f
>
> Yep, it looks like the above would work for the majority of these.
> That's probably Good Enough^tm.

Any trick you used to find all of there weird version numbers?  :-)

>>>> +  (define no-delims
>>>> +    (if (string-match delim-regexp no-suffix)
>>>> +        (string-split* no-suffix delim*)
>>>> +        (git-tag-error 'tag-version-delimiter)))
>>>
>>> This throws an error if the version doesn't have any delimiter.
>>
>> Setting the ‘tag-version-delimiter’ prefix to an empty string would
>> solve this, right?  Or, maybe we should just get rid of the delimiter
>> thing since only a few packages use a different delimiter.
>
> IMO, just get rid of the delimiter.  If we wanted to be *that* flexible,
> we could make it so they provide a tag->version proc instead of (prefix,
> suffix, delimiter).

a ‘tag->version’ procedure would probably make things a bit too
complicated for the people writing package definitions.  For example,
having a delimiter would make it easy to match a tag like
“2021-01-01-release”

Delimiter is “.” (sorry if this hurts your eyes ;-))

scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^\\.[:punct:]]+(\\.[^\\.[:punct:]]+)*).*$" "2021-01-01-release") 1)
$28 = "2021"

Delimiter is “-”

scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^-[:punct:]]+(-[^-[:punct:]]+)*).*$" "2021-01-01-release") 1)
$29 = "2021-01-01-release"

And then, setting the suffix to “-release” would match just the version
part.


On Sun, Sep 05 2021, Sarah Morgensen wrote (again):

>>> And this lets us just do something like (untested):
>>>
>>> (define* (get-version tag #:key prefix suffix delim)
>>>   (define delim-rx (regexp-quote (or delim ".")))
>>>   (define prefix-rx (or prefix "[^[:digit:]]*"))
>>>   (define suffix-rx (or suffix ".*"))
>>>   (define version-char-rx
>>>    (string-append "[^" delim-rx "[:punct:]]"))
>>>
>>>   (define tag-rx
>>>    (string-append "^" prefix "(" version-char-rx "+("
>>>                   delim-rx version-char-rx ")*)" suffix-rx "$"))
>>
>> This wouldn’t match anything if the version is just a plain number,
>> e.g., 1 or 09.
>
> It does,

Oh, I missed the extra pair of parens, sorry about that.

> but I had many errors in the definition.  Again, apologies.  I
> shouldn't send emails that late, haha.  This method should read:
>
>  --8<---------------cut here---------------start------------->8---
>  (define* (get-version tag #:key prefix suffix delim)
>    (define delim-rx (regexp-quote (or delim ".")))
>    (define prefix-rx (or prefix "[^[:digit:]]*"))
>    (define suffix-rx (or suffix ".*"))
>    (define version-char-rx
>     (string-append "[^" delim-rx "[:punct:]]"))
>
>    (define tag-rx
>     (string-append "^" prefix-rx "(" version-char-rx "+("
>                    delim-rx version-char-rx "+)*)" suffix-rx "$"))
>    (and=> (string-match tag-rx tag)
>           (cut match:substring <> 1)))
> --8<---------------cut here---------------end--------------->8---
>
>>
>> With this, something like “1.4.0rc1-450-g2725ef99d” will result in
>> “1.4.0” being returned, which is incorrect.  Changing (cut
>> match:substring <> 1) to just ‘match:substring’ would solve the issue,
>> but then pre-release tags, which we usually don’t want,  would also get
>> matched.  Not sure what the best option would be in this case.
>>
>
> With the fixed method above:
>
> scheme@(emacs-guix)> (get-version "8")
> $16 = "8"
> scheme@(emacs-guix)> (get-version "1.4.0rc1-450-g2725ef99d")
> $17 = "1.4.0rc1"
>
> But, we still get:
>
> scheme@(emacs-guix)> (get-version "1.4.0-rc1")
> $18 = "1.4.0"
>
> which leads us to what you talked about in your other message.

Hmm, maybe we could check that if (string-append "1.4.0" suffix) is a
suffix on of the tag, or is this too much overhead?  This would only
work if we set the suffix to the empty string by default.

Since (string-match "1.4.0$" "1.4.0-rc1") returns #f, this tag would get
filtered out.  But then a suffix would have to be specified to match
"1.4.0rc1-450-g2725ef99d".

Not sure what the best option is here.

>>> +(define* (ls-remote-refs url #:key tags?)
>>> +  "Return the list of references advertised at Git repository URL.  If TAGS?
>>> +is true, limit to only refs/tags."
>>> +  (define (ref? ref)
>>> +    ;; Like `git ls-remote --refs', only show actual references.
>>> +    (and (string-prefix? "refs/" ref)
>>> +         (not (string-suffix? "^{}" ref))))
>>> +
>>> +  (define (tag? ref)
>>> +    (string-prefix? "refs/tags/" ref))
>>> +
>>> +  (define (include? ref)
>>> +    (and ref?
>
> This should be:
>         (and (ref? ref)

Ah, problem solved!  :-)

>>> +         (or (not tags?) (tag? ref))))
>>> +
>>> +  (with-libgit2
>>> +   (with-temporary-directory
>>> +    (lambda (cache-directory)
>>> +      (let* ((repository (repository-init cache-directory))
>>> +             ;; Create an in-memory remote so we don't touch disk.
>>> +             (remote (remote-create-anonymous repository url)))
>>> +        (remote-connect remote)
>>> +        (remote-disconnect remote)
>>> +        (repository-close! repository)
>>> +
>>> +        (filter include? (map remote-head-name (remote-ls remote))))))))
>>>
>>
>> For some reason it seems to include refs that do and don’t end with
>> “^{}”
>
> Sorry, another typo I missed.  See above.

No worries, thanks for taking the time to review this!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-06 12:20       ` Xinglu Chen
@ 2021-09-07  1:00         ` Sarah Morgensen
  2021-09-07 19:13           ` Xinglu Chen
  0 siblings, 1 reply; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-07  1:00 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 2128 bytes --]

Hi,

Xinglu Chen <public@yoctocell.xyz> writes:

> Any trick you used to find all of there weird version numbers?  :-)

This monstrosity:

  rg -U -B4 --pcre2 '(?!\(let.*(\n.*){0,1})\(version "([^\n"]*[^0-9\.][^"\n]*)".*(\n.*){0,10}commit.*version' gnu/packages

and to show just the versions:

  rg -Uor '$2' --pcre2 --no-filename --no-line-number 

>> IMO, just get rid of the delimiter.  If we wanted to be *that* flexible,
>> we could make it so they provide a tag->version proc instead of (prefix,
>> suffix, delimiter).
>
> a ‘tag->version’ procedure would probably make things a bit too
> complicated for the people writing package definitions.  For example,
> having a delimiter would make it easy to match a tag like
> “2021-01-01-release”
>
> Delimiter is “.” (sorry if this hurts your eyes ;-))
>
> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^\\.[:punct:]]+(\\.[^\\.[:punct:]]+)*).*$" "2021-01-01-release") 1)
> $28 = "2021"
>
> Delimiter is “-”
>
> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^-[:punct:]]+(-[^-[:punct:]]+)*).*$" "2021-01-01-release") 1)
> $29 = "2021-01-01-release"
>
> And then, setting the suffix to “-release” would match just the version
> part.

Right.  I missed that.

In that vein, should we keep the dashes in "2021-01-01" or convert them
to periods?  What about when a tag has underscores?

What if a repo has tags in both formats?  Then "3.0.1" would be
considered older than "2011-01-01".

Maybe we should just add an extra bit to detect a date format and only
consider it when there's no "proper versions"?

Aaaand I fell down a rabbit hole after that :) I've attached a patch
with what I've done.  It still has lots of issues--it requires the tag
to contain at least one version delimiter, it requires the first
character of the version to be a number... it might not even be better
than before I touched it, and even so the added complexity might not be
worth it.  But if you'd like to take it for a spin, I've attached it (it
applies straight on master).

--
Sarah


[-- Attachment #2: the rabbit hole --]
[-- Type: text/x-patch, Size: 11637 bytes --]

From 08bd59a7fa1aa9735a1794672ce8d1f683d3d6db Mon Sep 17 00:00:00 2001
Message-Id: <08bd59a7fa1aa9735a1794672ce8d1f683d3d6db.1630975873.git.iskarian@mgsn.dev>
From: Xinglu Chen <public@yoctocell.xyz>
Date: Fri, 3 Sep 2021 17:50:56 +0200
Subject: [PATCH] import: Add 'generic-git' updater.

* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* Makefile.am (MODULES): Register it.
---
 Makefile.am         |   1 +
 doc/guix.texi       |  27 +++++++
 guix/git.scm        |  33 ++++++++
 guix/import/git.scm | 191 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 252 insertions(+)
 create mode 100644 guix/import/git.scm

diff --git a/Makefile.am b/Makefile.am
index 3c79760734..c4d3a456b1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 36a0c7f5ec..26afb1607a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((tag-prefix . "^release0-")
+      (tag-suffix . "[a-z]?$")
+      (tag-version-delimiter . ":"))))
+@end lisp      
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..c5d0d2da8e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -56,6 +56,8 @@
             commit-difference
             commit-relation
 
+            ls-remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (ls-remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+        (remote-disconnect remote)
+        (repository-close! repository)
+
+        (filter include? (map remote-head-name (remote-ls remote))))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..8568981af2
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,191 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (srfi srfi-71)
+  #:export (%generic-git-updater))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `tag-prefix',
+;;; `tag-suffix' and `tag-version-delimiter' properties of the package to make
+;;; the updater parse the Git tag name correctly.
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+\f
+;;; Updater
+
+(define* (get-version-mapping tags #:key prefix suffix delim)
+  (define (guess-delim)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      ;; (format #t "total: ~d, dots: ~d, dashes ~d, underscores ~d~%"
+      ;;         total dots dashes underscores)
+      (cond
+       ((> dots (* total 0.35)) ".")
+       ((> dashes (* total 0.8)) "-")
+       ((> underscores (* total 0.8)) "_")
+       (else "."))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delim))))
+  (define suffix-rx (or suffix ""))
+
+  (define prefix-rx
+    (make-regexp (string-append "^" (or prefix ".*") "$")))
+  (define tag-rx
+    (make-regexp
+     (string-append "([[:digit:]][^" delim-rx "[:punct:]]*"
+                    "(" delim-rx "[^" delim-rx "]+)+"
+                    ")" suffix-rx "$")))
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec tag-rx tag)))
+      (and tag-match
+           (regexp-exec prefix-rx (match:prefix tag-match))
+           (regexp-substitute/global
+            #f delim-rx (match:substring tag-match 1)
+            'pre "." 'post))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (let ((mapping (fold alist-cons '() (map get-version tags) tags)))
+    (stable-sort! (filter car mapping) entry<?)))
+
+(define* (get-latest-tag url #:key prefix suffix delim)
+  "Return the latest tag available from the Git repository at URL."
+  (define (pre-release? tag)
+    (any (cut string-contains tag <>)
+         '("alpha" "beta" "rc" "dev" "test")))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (ls-remote-refs url #:tags? #t)))
+         (versions->tags
+          (get-version-mapping (filter (negate pre-release?) tags)
+                               #:prefix prefix
+                               #:suffix suffix
+                               #:delim delim)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package tag-prefix tag-suffix
+                                tag-version-delimiter)
+  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, and TAG-VERSION-DELIMITER
+properties of PACKAGE, returns the latest version of PACKAGE."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source))))
+      ;;(format #t "~a~%" (package-name package))
+      (get-latest-tag url #:prefix tag-prefix #:suffix tag-suffix
+                      #:delim tag-version-delimiter))))
+
+(define (git-package? package)
+  "Whether the origin of PACKAGE is a Git repostiory."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (properties (package-properties package))
+         (tag-prefix (assq-ref properties 'tag-prefix))
+         (tag-suffix (assq-ref properties 'tag-suffix))
+         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package
+                                              tag-prefix
+                                              tag-suffix
+                                              tag-version-delimiter)))
+
+    (if new-version
+        (upstream-source
+         (package name)
+         (version new-version)
+         (urls (list url)))
+        ;; No new release or no tags available.
+        #f)))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))

base-commit: 522a3bf99cbc21a9093f63280b9508cd69b94ff0
-- 
2.32.0


^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-07  1:00         ` Sarah Morgensen
@ 2021-09-07 19:13           ` Xinglu Chen
  2021-09-08 18:28             ` Xinglu Chen
  0 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-07 19:13 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: 50359

[-- Attachment #1: Type: text/plain, Size: 16391 bytes --]

On Mon, Sep 06 2021, Sarah Morgensen wrote:

> Hi,
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> Any trick you used to find all of there weird version numbers?  :-)
>
> This monstrosity:
>
>   rg -U -B4 --pcre2 '(?!\(let.*(\n.*){0,1})\(version "([^\n"]*[^0-9\.][^"\n]*)".*(\n.*){0,10}commit.*version' gnu/packages
>
> and to show just the versions:
>
>   rg -Uor '$2' --pcre2 --no-filename --no-line-number 

Wow!  I will try that and see for myself!  :-)

>>> IMO, just get rid of the delimiter.  If we wanted to be *that* flexible,
>>> we could make it so they provide a tag->version proc instead of (prefix,
>>> suffix, delimiter).
>>
>> a ‘tag->version’ procedure would probably make things a bit too
>> complicated for the people writing package definitions.  For example,
>> having a delimiter would make it easy to match a tag like
>> “2021-01-01-release”
>>
>> Delimiter is “.” (sorry if this hurts your eyes ;-))
>>
>> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^\\.[:punct:]]+(\\.[^\\.[:punct:]]+)*).*$" "2021-01-01-release") 1)
>> $28 = "2021"
>>
>> Delimiter is “-”
>>
>> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^-[:punct:]]+(-[^-[:punct:]]+)*).*$" "2021-01-01-release") 1)
>> $29 = "2021-01-01-release"
>>
>> And then, setting the suffix to “-release” would match just the version
>> part.
>
> Right.  I missed that.
>
> In that vein, should we keep the dashes in "2021-01-01" or convert them
> to periods?

Having periods would be more consistent, then could have a
‘date->version’ procedure that replaces the hyphens with dots and have

  (git-reference
    (url "https://git.example.org")
    (commit (date->version version)))

> What about when a tag has underscores?

Hmm, not sure about that, below is a list of packages I could find which had
underscores as delimiters

gnu/packages/graphics.scm
239:          (commit "DIRECTFB_1_7_7")))
gnu/packages/gstreamer.scm
326:          (commit "ESOUND_0_2_41")))
gnu/packages/java.scm
13925:                      (commit "jboss-transaction-api_1.2_spec-1.1.1.Final")))

They all seem to use periods in the ‘version’ field, though, so I would
say that the underscroes, should also be converted to periods.

> What if a repo has tags in both formats?  Then "3.0.1" would be
> considered older than "2011-01-01".

That’s tricky, there isn’t really a way to know how old “3.0.1” is,
without looking at the metadata of the tag.  Maybe this is one of those
corner cases which can’t really automatically determine the latest
release.  Should we have a ‘no-refresh?’ property to tell the refresh to
not try to update the package?

> Maybe we should just add an extra bit to detect a date format and only
> consider it when there's no "proper versions"?

That could be a good idea!

> Aaaand I fell down a rabbit hole after that :) I've attached a patch
> with what I've done.  It still has lots of issues--it requires the tag
> to contain at least one version delimiter, it requires the first
> character of the version to be a number... it might not even be better
> than before I touched it, and even so the added complexity might not be
> worth it.  But if you'd like to take it for a spin, I've attached it (it
> applies straight on master).

Great! I will try it out and see how it compares to my current WIP
version.

Not having characters in the first version number probably isn’t such a
big deal, most version that contain characters end with a character.
E.g., “1.2.3a” is not to uncommon, but “a1.2.3” is rarely seen.

> --
> Sarah
>
> From 08bd59a7fa1aa9735a1794672ce8d1f683d3d6db Mon Sep 17 00:00:00 2001
> Message-Id: <08bd59a7fa1aa9735a1794672ce8d1f683d3d6db.1630975873.git.iskarian@mgsn.dev>
> From: Xinglu Chen <public@yoctocell.xyz>
> Date: Fri, 3 Sep 2021 17:50:56 +0200
> Subject: [PATCH] import: Add 'generic-git' updater.
>
> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * Makefile.am (MODULES): Register it.
> ---
>  Makefile.am         |   1 +
>  doc/guix.texi       |  27 +++++++
>  guix/git.scm        |  33 ++++++++
>  guix/import/git.scm | 191 ++++++++++++++++++++++++++++++++++++++++++++
>  4 files changed, 252 insertions(+)
>  create mode 100644 guix/import/git.scm
>
> diff --git a/Makefile.am b/Makefile.am
> index 3c79760734..c4d3a456b1 100644
> --- a/Makefile.am
> +++ b/Makefile.am
> @@ -254,6 +254,7 @@ MODULES =					\
>    guix/import/egg.scm   			\
>    guix/import/elpa.scm   			\
>    guix/import/gem.scm				\
> +  guix/import/git.scm                           \
>    guix/import/github.scm   			\
>    guix/import/gnome.scm				\
>    guix/import/gnu.scm				\
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 36a0c7f5ec..26afb1607a 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
>  @item generic-html
>  a generic updater that crawls the HTML page where the source tarball of
>  the package is hosted, when applicable.
> +@item generic-git
> +a generic updater for packages hosted on Git repositories.  It tries to
> +be smart about parsing Git tag names, but if it is not able to parse the
> +tag name and compare tags correctly, users can define the following
> +properties for a package.
> +
> +@itemize
> +@item @code{tag-prefix}: a regular expression for matching a prefix of
> +the tag name.
> +
> +@item @code{tag-suffix}: a regular expression for matching a suffix of
> +the tag name.
> +
> +@item @code{tag-version-delimiter}: a string used as the delimiter in
> +the tag name for separating the numbers of the version.
> +@end itemize
> +
> +@lisp
> +(package
> +  (name "foo")
> +  ;; ...
> +  (properties
> +    '((tag-prefix . "^release0-")
> +      (tag-suffix . "[a-z]?$")
> +      (tag-version-delimiter . ":"))))
> +@end lisp      
> +
>  @end table
>  
>  For instance, the following command only checks for updates of Emacs
> diff --git a/guix/git.scm b/guix/git.scm
> index 9c6f326c36..c5d0d2da8e 100644
> --- a/guix/git.scm
> +++ b/guix/git.scm
> @@ -56,6 +56,8 @@
>              commit-difference
>              commit-relation
>  
> +            ls-remote-refs
> +
>              git-checkout
>              git-checkout?
>              git-checkout-url
> @@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
>                (if (set-contains? oldest new)
>                    'descendant
>                    'unrelated))))))
> +\f
> +;;
> +;;; Remote operations.
> +;;;
> +
> +(define* (ls-remote-refs url #:key tags?)
> +  "Return the list of references advertised at Git repository URL.  If TAGS?
> +is true, limit to only refs/tags."
> +  (define (ref? ref)
> +    ;; Like `git ls-remote --refs', only show actual references.
> +    (and (string-prefix? "refs/" ref)
> +         (not (string-suffix? "^{}" ref))))
> +
> +  (define (tag? ref)
> +    (string-prefix? "refs/tags/" ref))
> +
> +  (define (include? ref)
> +    (and (ref? ref)
> +         (or (not tags?) (tag? ref))))
> +
> +  (with-libgit2
> +   (call-with-temporary-directory
> +    (lambda (cache-directory)
> +      (let* ((repository (repository-init cache-directory))
> +             ;; Create an in-memory remote so we don't touch disk.
> +             (remote (remote-create-anonymous repository url)))
> +        (remote-connect remote)
> +        (remote-disconnect remote)
> +        (repository-close! repository)
> +
> +        (filter include? (map remote-head-name (remote-ls remote))))))))
>  
>  \f
>  ;;;
> diff --git a/guix/import/git.scm b/guix/import/git.scm
> new file mode 100644
> index 0000000000..8568981af2
> --- /dev/null
> +++ b/guix/import/git.scm
> @@ -0,0 +1,191 @@
> +;;; GNU Guix --- Functional package management for GNU
> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
> +;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
> +;;;
> +;;; This file is part of GNU Guix.
> +;;;
> +;;; GNU Guix is free software; you can redistribute it and/or modify it
> +;;; under the terms of the GNU General Public License as published by
> +;;; the Free Software Foundation; either version 3 of the License, or (at
> +;;; your option) any later version.
> +;;;
> +;;; GNU Guix is distributed in the hope that it will be useful, but
> +;;; WITHOUT ANY WARRANTY; without even the implied warranty of
> +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
> +;;; GNU General Public License for more details.
> +;;;
> +;;; You should have received a copy of the GNU General Public License
> +;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
> +
> +(define-module (guix import git)
> +  #:use-module (guix build utils)
> +  #:use-module (guix diagnostics)
> +  #:use-module (guix git)
> +  #:use-module (guix git-download)
> +  #:use-module (guix i18n)
> +  #:use-module (guix packages)
> +  #:use-module (guix upstream)
> +  #:use-module (guix utils)
> +  #:use-module (ice-9 format)
> +  #:use-module (ice-9 match)
> +  #:use-module (ice-9 rdelim)
> +  #:use-module (ice-9 regex)
> +  #:use-module (srfi srfi-1)
> +  #:use-module (srfi srfi-26)
> +  #:use-module (srfi srfi-34)
> +  #:use-module (srfi srfi-35)
> +  #:use-module (srfi srfi-71)
> +  #:export (%generic-git-updater))
> +
> +;;; Commentary:
> +;;;
> +;;; This module provides a generic package updater for packages hosted on Git
> +;;; repositories.
> +;;;
> +;;; It tries to be smart about tag names, but if it is not automatically able
> +;;; to parse the tag names correctly, users can set the `tag-prefix',
> +;;; `tag-suffix' and `tag-version-delimiter' properties of the package to make
> +;;; the updater parse the Git tag name correctly.
> +;;;
> +;;; Code:
> +
> +;;; Errors & warnings
> +
> +(define-condition-type &git-no-valid-tags-error &error
> +  git-no-valid-tags-error?)
> +
> +(define (git-no-valid-tags-error)
> +  (raise (condition (&message (message "no valid tags found"))
> +                    (&git-no-valid-tags-error))))
> +
> +(define-condition-type &git-no-tags-error &error
> +  git-no-tags-error?)
> +
> +(define (git-no-tags-error)
> +  (raise (condition (&message (message "no tags were found"))
> +                    (&git-no-tags-error))))
> +
> +\f
> +;;; Updater
> +
> +(define* (get-version-mapping tags #:key prefix suffix delim)
> +  (define (guess-delim)
> +    (let ((total (length tags))
> +          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
> +          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
> +          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
> +      ;; (format #t "total: ~d, dots: ~d, dashes ~d, underscores ~d~%"
> +      ;;         total dots dashes underscores)
> +      (cond
> +       ((> dots (* total 0.35)) ".")
> +       ((> dashes (* total 0.8)) "-")
> +       ((> underscores (* total 0.8)) "_")
> +       (else "."))))

These numbers seem rather arbitrary, how did you arrive at them?

Also, AFAICS, versions without delimiters won’t be matched.

> +  (define delim-rx (regexp-quote (or delim (guess-delim))))
> +  (define suffix-rx (or suffix ""))
> +
> +  (define prefix-rx
> +    (make-regexp (string-append "^" (or prefix ".*") "$")))

Why is there a $ here?

> +  (define tag-rx
> +    (make-regexp
> +     (string-append "([[:digit:]][^" delim-rx "[:punct:]]*"
> +                    "(" delim-rx "[^" delim-rx "]+)+"
> +                    ")" suffix-rx "$")))
> +
> +  (define (get-version tag)
> +    (let ((tag-match (regexp-exec tag-rx tag)))
> +      (and tag-match
> +           (regexp-exec prefix-rx (match:prefix tag-match))
> +           (regexp-substitute/global
> +            #f delim-rx (match:substring tag-match 1)
> +            'pre "." 'post))))
> +
> +  (define (entry<? a b)
> +    (eq? (version-compare (car a) (car b)) '<))
> +
> +  (let ((mapping (fold alist-cons '() (map get-version tags) tags)))
> +    (stable-sort! (filter car mapping) entry<?)))
> +
> +(define* (get-latest-tag url #:key prefix suffix delim)
> +  "Return the latest tag available from the Git repository at URL."
> +  (define (pre-release? tag)
> +    (any (cut string-contains tag <>)
> +         '("alpha" "beta" "rc" "dev" "test")))

This would only match lower-case characters, but sometimes upper-case
characters are used.

  (define (pre-release? tag)
    (any (lambda (rx) (regexp-exec (make-regexp rx regexp/icase) tag))
              '("alpha" "beta" "rc" "dev" "test")))
              
> +  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
> +                    (ls-remote-refs url #:tags? #t)))
> +         (versions->tags
> +          (get-version-mapping (filter (negate pre-release?) tags)
> +                               #:prefix prefix
> +                               #:suffix suffix
> +                               #:delim delim)))
> +    (cond
> +     ((null? tags)
> +      (git-no-tags-error))
> +     ((null? versions->tags)
> +      (git-no-valid-tags-error))
> +     (else
> +      (match (last versions->tags)
> +        ((version . tag)
> +         (values version tag)))))))
> +
> +(define (latest-git-tag-version package tag-prefix tag-suffix
> +                                tag-version-delimiter)
> +  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, and TAG-VERSION-DELIMITER
> +properties of PACKAGE, returns the latest version of PACKAGE."
> +  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
> +             (warning (or (package-field-location package 'source)
> +                          (package-location package))
> +                      (G_ "~a for ~a~%")
> +                      (condition-message c)
> +                      (package-name package))
> +             #f)
> +            ((eq? (exception-kind c) 'git-error)
> +             (warning (or (package-field-location package 'source)
> +                          (package-location package))
> +                      (G_ "failed to fetch Git repository for ~a~%")
> +                      (package-name package))
> +             #f))
> +    (let* ((source (package-source package))
> +           (url (git-reference-url (origin-uri source))))
> +      ;;(format #t "~a~%" (package-name package))
> +      (get-latest-tag url #:prefix tag-prefix #:suffix tag-suffix
> +                      #:delim tag-version-delimiter))))
> +
> +(define (git-package? package)
> +  "Whether the origin of PACKAGE is a Git repostiory."
> +  (match (package-source package)
> +    ((? origin? origin)
> +     (and (eq? (origin-method origin) git-fetch)
> +          (git-reference? (origin-uri origin))))
> +    (_ #f)))
> +
> +(define (latest-git-release package)
> +  "Return the latest release of PACKAGE."
> +  (let* ((name (package-name package))
> +         (properties (package-properties package))
> +         (tag-prefix (assq-ref properties 'tag-prefix))
> +         (tag-suffix (assq-ref properties 'tag-suffix))
> +         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
> +         (old-version (package-version package))
> +         (url (git-reference-url (origin-uri (package-source package))))
> +         (new-version (latest-git-tag-version package
> +                                              tag-prefix
> +                                              tag-suffix
> +                                              tag-version-delimiter)))
> +
> +    (if new-version
> +        (upstream-source
> +         (package name)
> +         (version new-version)
> +         (urls (list url)))
> +        ;; No new release or no tags available.
> +        #f)))
> +
> +(define %generic-git-updater
> +  (upstream-updater
> +   (name 'generic-git)
> +   (description "Updater for packages hosted on Git repositories")
> +   (pred git-package?)
> +   (latest latest-git-release)))
>
> base-commit: 522a3bf99cbc21a9093f63280b9508cd69b94ff0
> -- 
> 2.32.0

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-07 19:13           ` Xinglu Chen
@ 2021-09-08 18:28             ` Xinglu Chen
  2021-09-10  8:36               ` Ludovic Courtès
  0 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-08 18:28 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: 50359


[-- Attachment #1.1: Type: text/plain, Size: 4713 bytes --]

On Tue, Sep 07 2021, Xinglu Chen wrote:

> On Mon, Sep 06 2021, Sarah Morgensen wrote:
>
>> Hi,
>>
>> Xinglu Chen <public@yoctocell.xyz> writes:
>>
>>> Any trick you used to find all of there weird version numbers?  :-)
>>
>> This monstrosity:
>>
>>   rg -U -B4 --pcre2 '(?!\(let.*(\n.*){0,1})\(version "([^\n"]*[^0-9\.][^"\n]*)".*(\n.*){0,10}commit.*version' gnu/packages
>>
>> and to show just the versions:
>>
>>   rg -Uor '$2' --pcre2 --no-filename --no-line-number 
>
> Wow!  I will try that and see for myself!  :-)
>
>>>> IMO, just get rid of the delimiter.  If we wanted to be *that* flexible,
>>>> we could make it so they provide a tag->version proc instead of (prefix,
>>>> suffix, delimiter).
>>>
>>> a ‘tag->version’ procedure would probably make things a bit too
>>> complicated for the people writing package definitions.  For example,
>>> having a delimiter would make it easy to match a tag like
>>> “2021-01-01-release”
>>>
>>> Delimiter is “.” (sorry if this hurts your eyes ;-))
>>>
>>> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^\\.[:punct:]]+(\\.[^\\.[:punct:]]+)*).*$" "2021-01-01-release") 1)
>>> $28 = "2021"
>>>
>>> Delimiter is “-”
>>>
>>> scheme@(guile-user)> (match:substring (string-match "^[^0-9]*([^-[:punct:]]+(-[^-[:punct:]]+)*).*$" "2021-01-01-release") 1)
>>> $29 = "2021-01-01-release"
>>>
>>> And then, setting the suffix to “-release” would match just the version
>>> part.
>>
>> Right.  I missed that.
>>
>> In that vein, should we keep the dashes in "2021-01-01" or convert them
>> to periods?
>
> Having periods would be more consistent, then could have a
> ‘date->version’ procedure that replaces the hyphens with dots and have
>
>   (git-reference
>     (url "https://git.example.org")
>     (commit (date->version version)))
>
>> What about when a tag has underscores?
>
> Hmm, not sure about that, below is a list of packages I could find which had
> underscores as delimiters
>
> gnu/packages/graphics.scm
> 239:          (commit "DIRECTFB_1_7_7")))
> gnu/packages/gstreamer.scm
> 326:          (commit "ESOUND_0_2_41")))
> gnu/packages/java.scm
> 13925:                      (commit "jboss-transaction-api_1.2_spec-1.1.1.Final")))
>
> They all seem to use periods in the ‘version’ field, though, so I would
> say that the underscroes, should also be converted to periods.
>
>> What if a repo has tags in both formats?  Then "3.0.1" would be
>> considered older than "2011-01-01".
>
> That’s tricky, there isn’t really a way to know how old “3.0.1” is,
> without looking at the metadata of the tag.  Maybe this is one of those
> corner cases which can’t really automatically determine the latest
> release.  Should we have a ‘no-refresh?’ property to tell the refresh to
> not try to update the package?
>
>> Maybe we should just add an extra bit to detect a date format and only
>> consider it when there's no "proper versions"?
>
> That could be a good idea!
>
>> Aaaand I fell down a rabbit hole after that :) I've attached a patch
>> with what I've done.  It still has lots of issues--it requires the tag
>> to contain at least one version delimiter, it requires the first
>> character of the version to be a number... it might not even be better
>> than before I touched it, and even so the added complexity might not be
>> worth it.  But if you'd like to take it for a spin, I've attached it (it
>> applies straight on master).
>
> Great! I will try it out and see how it compares to my current WIP
> version.
>
> Not having characters in the first version number probably isn’t such a
> big deal, most version that contain characters end with a character.
> E.g., “1.2.3a” is not to uncommon, but “a1.2.3” is rarely seen.

I made some changes, to the patch and ran ‘guix refresh -t generic-git |
grep "^gnu/packages.*no valid’; I also modified the ‘github’ updater so
that it wouldn’t be used.
  
  (define %github-updater
    (upstream-updater
     (name 'github)
     (description "Updater for GitHub packages")
     (pred (const #f)) ;this right here
     (latest latest-release)))

Attached is a file with all the packages that didn’t have any valid
tags, and with a short description of perharps why no valid tags were
found.

Something I noticed was the a lot of Julia package use a version scheme
like this:

  (version "1.2.3+0")

The "+0" is included in the version field and acts like a “revision”; I
am not familiar with the Julia ecosystem, and I am not sure how we
should handle this situation.

The updated patch is also attached.


[-- Attachment #1.2: no-valid-tags --]
[-- Type: application/octet-stream, Size: 17569 bytes --]

;;; Custom prefix or suffix (should be solvable by us)
;; kmscon- prefix
gnu/packages/terminals.scm:281:14: warning: no valid tags found for kmscon

;; v1.2-<num>
gnu/packages/statistics.scm:5701:5: warning: no valid tags found for r-colorout

;; <CHAR><num>
gnu/packages/sdl.scm:662:14: warning: no valid tags found for sdl2-cs

;; test- prefix
gnu/packages/qt.scm:118:7: warning: no valid tags found for qite

;; "v" prefix, "-stable" suffix
gnu/packages/opencog.scm:76:14: warning: no valid tags found for atomspace
gnu/packages/opencog.scm:44:14: warning: no valid tags found for cogutil

;; +<num> suffix
gnu/packages/ocaml.scm:603:12: warning: no valid tags found for ocaml-mccs

;; "version-" prefix
gnu/packages/minetest.scm:600:5: warning: no valid tags found for minetest-unified-inventory

;; "maven-resources-plugin-" prefix
gnu/packages/maven.scm:2980:12: warning: no valid tags found for maven-resources-plugin

;; "txr-" prefix
gnu/packages/lisp.scm:912:5: warning: no valid tags found for txr

;; release- prefix
gnu/packages/algebra.scm:1420:12: warning: no valid tags found for m4ri
gnu/packages/algebra.scm:1510:12: warning: no valid tags found for m4rie

;; lrcalc- prefix
gnu/packages/algebra.scm:1566:12: warning: no valid tags found for lrcalc

;; 3.3.06-1, -<num> suffix
gnu/packages/admin.scm:4046:2: warning: no valid tags found for inxi
gnu/packages/admin.scm:3977:7: warning: no valid tags found for inxi-minimal

;; -release-DATE+SOME-RANDOM-NUMBERS, refs/tags/2.0.180-release-20210315231707
gnu/packages/bioinformatics.scm:11189:12: warning: no valid tags found for biobambam2
gnu/packages/bioinformatics.scm:11149:12: warning: no valid tags found for libmaus2

;; "+git<date>" suffix
gnu/packages/gnome.scm:11878:12: warning: no valid tags found for feedbackd

;; "fest-test-" prefix
gnu/packages/java.scm:10900:12: warning: no valid tags found for java-fest-test

;; "-stable" suffix
gnu/packages/game-development.scm:1722:12: warning: no valid tags found for godot

;; "v" prefix, "-debian" suffix
gnu/packages/gstreamer.scm:95:5: warning: no valid tags found for openni2


;; +<num> suffix, but this is part of the `version' field as well, not
;; sure what to do about this
;;
;; (version "1.5.0+0")
gnu/packages/julia-jll.scm:366:6: warning: no valid tags found for julia-fribidi-jll
gnu/packages/julia-jll.scm:2520:6: warning: no valid tags found for julia-xorg-xtrans-jll
gnu/packages/julia-jll.scm:1812:6: warning: no valid tags found for julia-xorg-libx11-jll
gnu/packages/julia-jll.scm:1149:6: warning: no valid tags found for julia-libvorbis-jll
gnu/packages/julia-jll.scm:1491:6: warning: no valid tags found for julia-qt5base-jll
gnu/packages/julia-jll.scm:1415:6: warning: no valid tags found for julia-pcre-jll
gnu/packages/julia-jll.scm:1964:6: warning: no valid tags found for julia-xorg-libxdmcp-jll
gnu/packages/julia-jll.scm:1581:6: warning: no valid tags found for julia-wayland-protocols-jll
gnu/packages/julia-jll.scm:694:6: warning: no valid tags found for julia-lame-jll
gnu/packages/julia-jll.scm:2261:6: warning: no valid tags found for julia-xorg-xcb-util-jll
gnu/packages/julia-jll.scm:1618:6: warning: no valid tags found for julia-x264-jll
gnu/packages/julia-jll.scm:1926:6: warning: no valid tags found for julia-xorg-libxcursor-jll
gnu/packages/julia-jll.scm:920:6: warning: no valid tags found for julia-libgpg-error-jll
gnu/packages/julia-jll.scm:882:6: warning: no valid tags found for julia-libglvnd-jll
gnu/packages/julia-jll.scm:486:6: warning: no valid tags found for julia-glib-jll
gnu/packages/julia-jll.scm:1850:6: warning: no valid tags found for julia-xorg-libxau-jll
gnu/packages/julia-jll.scm:106:6: warning: no valid tags found for julia-cairo-jll
gnu/packages/julia-jll.scm:2556:6: warning: no valid tags found for julia-xslt-jll
gnu/packages/julia-jll.scm:2298:6: warning: no valid tags found for julia-xorg-xcb-util-image-jll
gnu/packages/julia-jll.scm:2409:6: warning: no valid tags found for julia-xorg-xcb-util-wm-jll
gnu/packages/julia-jll.scm:657:6: warning: no valid tags found for julia-jpegturbo-jll
gnu/packages/julia-jll.scm:2074:6: warning: no valid tags found for julia-xorg-libxi-jll
gnu/packages/julia-jll.scm:1187:6: warning: no valid tags found for julia-lzo-jll
gnu/packages/julia-jll.scm:2000:6: warning: no valid tags found for julia-xorg-libxext-jll
gnu/packages/julia-jll.scm:843:6: warning: no valid tags found for julia-libgcrypt-jll
gnu/packages/julia-jll.scm:730:6: warning: no valid tags found for julia-libass-jll
gnu/packages/julia-jll.scm:1542:6: warning: no valid tags found for julia-wayland-jll
gnu/packages/julia-jll.scm:1111:6: warning: no valid tags found for julia-libuuid-jll
gnu/packages/julia-jll.scm:1072:6: warning: no valid tags found for julia-libtiff-jll
gnu/packages/julia-jll.scm:2224:6: warning: no valid tags found for julia-xorg-libxrender-jll
gnu/packages/julia-jll.scm:958:6: warning: no valid tags found for julia-libiconv-jll
gnu/packages/julia-jll.scm:996:6: warning: no valid tags found for julia-libmount-jll
gnu/packages/julia-jll.scm:1035:6: warning: no valid tags found for julia-libpng-jll
gnu/packages/julia-jll.scm:770:6: warning: no valid tags found for julia-libfdk-aac-jll
gnu/packages/julia-jll.scm:1735:6: warning: no valid tags found for julia-xml2-jll
gnu/packages/julia-jll.scm:806:6: warning: no valid tags found for julia-libffi-jll
gnu/packages/julia-jll.scm:1886:6: warning: no valid tags found for julia-xorg-libxcb-jll
gnu/packages/julia-jll.scm:2446:6: warning: no valid tags found for julia-xorg-xkbcomp-jll
gnu/packages/julia-jll.scm:1659:6: warning: no valid tags found for julia-x265-jll
gnu/packages/julia-jll.scm:2483:6: warning: no valid tags found for julia-xorg-xkeyboard-config-jll
gnu/packages/julia-jll.scm:443:6: warning: no valid tags found for julia-glfw-jll
gnu/packages/julia-jll.scm:2112:6: warning: no valid tags found for julia-xorg-libxinerama-jll
gnu/packages/julia-jll.scm:66:5: warning: no valid tags found for julia-bzip2-jll
gnu/packages/julia-jll.scm:569:6: warning: no valid tags found for julia-imagemagick-jll
gnu/packages/julia-jll.scm:1263:6: warning: no valid tags found for julia-ogg-jll
gnu/packages/julia-jll.scm:232:6: warning: no valid tags found for julia-ffmpeg-jll
gnu/packages/julia-jll.scm:1695:6: warning: no valid tags found for julia-xkbcommon-jll
gnu/packages/julia-jll.scm:2599:6: warning: no valid tags found for julia-zlib-jll
gnu/packages/julia-jll.scm:2335:6: warning: no valid tags found for julia-xorg-xcb-util-keysyms-jll
gnu/packages/julia-jll.scm:530:5: warning: no valid tags found for julia-gumbo-jll
gnu/packages/julia-jll.scm:2186:6: warning: no valid tags found for julia-xorg-libxrandr-jll
gnu/packages/julia-jll.scm:194:6: warning: no valid tags found for julia-expat-jll
gnu/packages/julia-jll.scm:1300:7: warning: no valid tags found for julia-openspecfun-jll
gnu/packages/julia-jll.scm:324:5: warning: no valid tags found for julia-freetype2-jll
gnu/packages/julia-jll.scm:1343:6: warning: no valid tags found for julia-openssl-jll
gnu/packages/julia-jll.scm:1225:5: warning: no valid tags found for julia-mbedtls-jll
gnu/packages/julia-jll.scm:152:5: warning: no valid tags found for julia-compilersupportlibraries-jll
gnu/packages/julia-jll.scm:2037:6: warning: no valid tags found for julia-xorg-libxfixes-jll
gnu/packages/julia-jll.scm:281:6: warning: no valid tags found for julia-fontconfig-jll
gnu/packages/julia-jll.scm:1775:6: warning: no valid tags found for julia-xorg-libpthread-stubs-jll
gnu/packages/julia-jll.scm:1379:6: warning: no valid tags found for julia-opus-jll
gnu/packages/julia-jll.scm:402:6: warning: no valid tags found for julia-gettext-jll
gnu/packages/julia-jll.scm:1453:6: warning: no valid tags found for julia-pixman-jll
gnu/packages/julia-jll.scm:2372:6: warning: no valid tags found for julia-xorg-xcb-util-renderutil-jll
gnu/packages/julia-jll.scm:2637:6: warning: no valid tags found for julia-zstd-jll
gnu/packages/julia-jll.scm:2149:6: warning: no valid tags found for julia-xorg-libxkbfile-jll

\f
;;; only pre-releases
gnu/packages/linux.scm:1306:7: warning: no valid tags found for rtl8812au-aircrack-ng-linux-module
gnu/packages/vim.scm:596:7: warning: no valid tags found for vim-solarized
gnu/packages/music.scm:2133:12: warning: no valid tags found for powertabeditor
gnu/packages/music.scm:4463:14: warning: no valid tags found for rkrlv2
gnu/packages/lua.scm:248:12: warning: no valid tags found for lua5.1-socket
gnu/packages/lua.scm:248:12: warning: no valid tags found for lua5.2-socket
gnu/packages/guile-xyz.scm:3863:12: warning: no valid tags found for guile-ac-d-bus
gnu/packages/golang.scm:4136:7: warning: no valid tags found for go-github-com-btcsuite-btcd-btcec
gnu/packages/games.scm:7274:5: warning: no valid tags found for colobot

;; _beta<num> suffix, refs/tags/v0.1_beta2
gnu/packages/compton.scm:50:7: warning: no valid tags found for compton

;; almost all tags are pre-releases
;; refs/tags/0.0.4-152-alpha
;; refs/tags/0.0.4-152-alpha^{}
;; refs/tags/0.0.4-172-alpha
;; refs/tags/0.0.4-172-alpha^{}
;; refs/tags/0.1.0-alpha
;; refs/tags/0.1.0-alpha^{}
;; refs/tags/0.1.1-alpha
;; refs/tags/0.1.1-alpha^{}
;; refs/tags/0.1.2-alpha
;; refs/tags/0.1.2-alpha^{}
;; refs/tags/0.2.0-alpha
;; refs/tags/0.2.0-alpha^{}
;; refs/tags/pre-extension
;; refs/tags/v0.0.2-alpha
;; refs/tags/v0.0.3-alpha
;; refs/tags/v0.0.4-alpha
;; refs/tags/v0.0.4-alpha^{}
;; refs/tags/v0.1.0-alpha
;; refs/tags/v0.1.0-alpha^{}
;; refs/tags/v0.1.2-candidate
;; refs/tags/v0.1.2-candidate^{}
gnu/packages/guile-xyz.scm:3488:12: warning: no valid tags found for nomad

\f
;;; no delimiter or just one version number
gnu/packages/mail.scm:587:5: warning: no valid tags found for neomutt
gnu/packages/sync.scm:518:12: warning: no valid tags found for casync
gnu/packages/pulseaudio.scm:315:12: warning: no valid tags found for ponymix
gnu/packages/networking.scm:1266:12: warning: no valid tags found for iputils
gnu/packages/music.scm:6884:12: warning: no valid tags found for a2jmidid
gnu/packages/emulators.scm:567:5: warning: no valid tags found for higan
gnu/packages/emacs-xyz.scm:11489:5: warning: no valid tags found for emacs-lua-mode
gnu/packages/diffoscope.scm:76:12: warning: no valid tags found for diffoscope
gnu/packages/cups.scm:67:14: warning: no valid tags found for brlaser
gnu/packages/code.scm:575:12: warning: no valid tags found for kcov
gnu/packages/gnome-xyz.scm:185:5: warning: no valid tags found for papirus-icon-theme
gnu/packages/gnome-xyz.scm:367:12: warning: no valid tags found for gnome-shell-extension-gsconnect
gnu/packages/gnome-xyz.scm:289:5: warning: no valid tags found for gnome-shell-extension-topicons-redux
gnu/packages/golang.scm:1116:5: warning: no valid tags found for go-github-com-op-go-logging
gnu/packages/java.scm:10579:12: warning: no valid tags found for java-javax-inject
gnu/packages/mail.scm:1415:12: warning: no valid tags found for notmuch-addrlookup-c






\f
;;; (Most likely) not solvable by us
;; only one tag "initial-commit"
gnu/packages/build-tools.scm:208:14: warning: no valid tags found for gn

;; ??? the weirdest version scheme???
;; refs/tags/bzr-revno-7894
;; refs/tags/moses-3.2.13-15-Nov-2012
;; refs/tags/moved-to-ure-based-r2l
;; refs/tags/obsolete-C++-PLN
;; refs/tags/obsolete-Python-PLN
;; refs/tags/old-embodiment_8-nov-2015
;; refs/tags/old-openpsi-Jinhua-Chua-2011
;; refs/tags/old-pattern-miner-11-Jun-2019
;; refs/tags/v0.1.4-stable
gnu/packages/opencog.scm:209:14: warning: no valid tags found for opencog

;; "quicklisp-" prefix, date instead of version number
gnu/packages/lisp-xyz.scm:3703:7: warning: no valid tags found for sbcl-portable-threads

;; no version number in tag
gnu/packages/guile-xyz.scm:3283:7: warning: no valid tags found for guile-srfi-180
gnu/packages/golang.scm:6193:14: warning: no valid tags found for go-github-com-golang-freetype
gnu/packages/messaging.scm:1495:14: warning: no valid tags found for libtoxcore
gnu/packages/networking.scm:3814:5: warning: no valid tags found for vde2
gnu/packages/lisp-xyz.scm:15892:6: warning: no valid tags found for cl-bodge-blobs-support
gnu/packages/lisp-xyz.scm:3120:7: warning: no valid tags found for cl-cffi-c-ref
gnu/packages/lisp-xyz.scm:5979:7: warning: no valid tags found for sbcl-ieee-floats
gnu/packages/engineering.scm:814:14: warning: no valid tags found for libfive
gnu/packages/cpp.scm:221:14: warning: no valid tags found for rct

;; "go.weekly." prefix, date instead of version
gnu/packages/golang.scm:3905:7: warning: no valid tags found for go-github-com-michiwend-golang-pretty

;; weird version scheme
;; refs/tags/V3
;; refs/tags/version_1
;; refs/tags/wyhash_alpha
;; refs/tags/wyhash_final
;; refs/tags/wyhash_v4
;; refs/tags/wyhash_v5
gnu/packages/digest.scm:36:12: warning: no valid tags found for wyhash




;;; couldn't be bothered to check...
gnu/packages/lisp-xyz.scm:6508:2: warning: no valid tags found for cl-trivia
gnu/packages/lisp-xyz.scm:12214:7: warning: no valid tags found for cl-mcclim
gnu/packages/lisp-xyz.scm:13633:7: warning: no valid tags found for cl-claw-utils
gnu/packages/lisp-xyz.scm:3195:7: warning: no valid tags found for sbcl-parenscript
gnu/packages/lisp-xyz.scm:6466:7: warning: no valid tags found for cl-trivia.trivial
gnu/packages/lisp-xyz.scm:6508:2: warning: no valid tags found for ecl-trivia
gnu/packages/lisp-xyz.scm:13566:5: warning: no valid tags found for cl-claw-support
gnu/packages/lisp-xyz.scm:9326:7: warning: no valid tags found for cl-jpeg
gnu/packages/lisp-xyz.scm:13566:5: warning: no valid tags found for sbcl-claw-support
gnu/packages/lisp-xyz.scm:18394:7: warning: no valid tags found for cl-tailrec
gnu/packages/lisp-xyz.scm:139:6: warning: no valid tags found for sbcl-bodge-utilities
gnu/packages/lisp-xyz.scm:15860:6: warning: no valid tags found for ecl-bodge-math
gnu/packages/lisp-xyz.scm:13566:5: warning: no valid tags found for ecl-claw-support
gnu/packages/lisp-xyz.scm:178:7: warning: no valid tags found for cl-bodge-queue
gnu/packages/lisp-xyz.scm:6508:2: warning: no valid tags found for sbcl-trivia
gnu/packages/lisp-xyz.scm:6807:7: warning: no valid tags found for sbcl-s-sysdeps
gnu/packages/lisp-xyz.scm:6466:7: warning: no valid tags found for ecl-trivia.trivial
gnu/packages/lisp-xyz.scm:519:7: warning: no valid tags found for cl-fiasco
gnu/packages/lisp-xyz.scm:6807:7: warning: no valid tags found for ecl-s-sysdeps
gnu/packages/lisp-xyz.scm:8929:7: warning: no valid tags found for ecl-cl-async
gnu/packages/lisp-xyz.scm:3195:7: warning: no valid tags found for cl-parenscript
gnu/packages/lisp-xyz.scm:9326:7: warning: no valid tags found for ecl-cl-jpeg
gnu/packages/lisp-xyz.scm:519:7: warning: no valid tags found for ecl-fiasco
gnu/packages/lisp-xyz.scm:3703:7: warning: no valid tags found for ecl-portable-threads
gnu/packages/lisp-xyz.scm:12214:7: warning: no valid tags found for sbcl-mcclim
gnu/packages/lisp-xyz.scm:8628:7: warning: no valid tags found for cl-misc-extensions
gnu/packages/lisp-xyz.scm:13633:7: warning: no valid tags found for ecl-claw-utils
gnu/packages/lisp-xyz.scm:5979:7: warning: no valid tags found for cl-ieee-floats
gnu/packages/lisp-xyz.scm:15892:6: warning: no valid tags found for ecl-bodge-blobs-support
gnu/packages/lisp-xyz.scm:3120:7: warning: no valid tags found for ecl-cffi-c-ref
gnu/packages/lisp-xyz.scm:5979:7: warning: no valid tags found for ecl-ieee-floats
gnu/packages/lisp-xyz.scm:139:6: warning: no valid tags found for cl-bodge-utilities
gnu/packages/lisp-xyz.scm:178:7: warning: no valid tags found for ecl-bodge-queue
gnu/packages/lisp-xyz.scm:9326:7: warning: no valid tags found for sbcl-cl-jpeg
gnu/packages/lisp-xyz.scm:519:7: warning: no valid tags found for sbcl-fiasco
gnu/packages/lisp-xyz.scm:15892:6: warning: no valid tags found for sbcl-bodge-blobs-support
gnu/packages/lisp-xyz.scm:139:6: warning: no valid tags found for ecl-bodge-utilities
gnu/packages/lisp-xyz.scm:3195:7: warning: no valid tags found for ecl-parenscript
gnu/packages/lisp-xyz.scm:3120:7: warning: no valid tags found for sbcl-cffi-c-ref
gnu/packages/lisp-xyz.scm:178:7: warning: no valid tags found for sbcl-bodge-queue
gnu/packages/lisp-xyz.scm:8628:7: warning: no valid tags found for ecl-misc-extensions
gnu/packages/lisp-xyz.scm:15860:6: warning: no valid tags found for sbcl-bodge-math
gnu/packages/lisp-xyz.scm:8628:7: warning: no valid tags found for sbcl-misc-extensions
gnu/packages/lisp-xyz.scm:15860:6: warning: no valid tags found for cl-bodge-math
gnu/packages/lisp-xyz.scm:13633:7: warning: no valid tags found for sbcl-claw-utils
gnu/packages/lisp-xyz.scm:6466:7: warning: no valid tags found for sbcl-trivia.trivial
gnu/packages/lisp-xyz.scm:18394:7: warning: no valid tags found for sbcl-tailrec
gnu/packages/lisp-xyz.scm:18394:7: warning: no valid tags found for ecl-tailrec
gnu/packages/lisp-xyz.scm:12214:7: warning: no valid tags found for ecl-mcclim
gnu/packages/lisp-xyz.scm:8929:7: warning: no valid tags found for sbcl-cl-async
gnu/packages/lisp-xyz.scm:6807:7: warning: no valid tags found for cl-s-sysdeps
gnu/packages/lisp-xyz.scm:8929:7: warning: no valid tags found for cl-async
gnu/packages/lisp-xyz.scm:3703:7: warning: no valid tags found for cl-portable-threads
gnu/packages/linux.scm:1306:7: warning: no valid tags found for rtl8812au-aircrack-ng-linux-module
gnu/packages/linux.scm:6284:5: warning: no valid tags found for mcelog
gnu/packages/kodi.scm:470:2: warning: no valid tags found for kodi-wayland
gnu/packages/kodi.scm:275:12: warning: no valid tags found for kodi

[-- Attachment #1.3: 0001-import-Add-generic-git-updater.patch --]
[-- Type: text/x-patch, Size: 12920 bytes --]

From f924dbb835425f6b9a5796918125592870391405 Mon Sep 17 00:00:00 2001
Message-Id: <f924dbb835425f6b9a5796918125592870391405.1631125652.git.public@yoctocell.xyz>
From: Xinglu Chen <public@yoctocell.xyz>
Date: Fri, 3 Sep 2021 17:50:56 +0200
Subject: [PATCH] import: Add 'generic-git' updater.

* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* Makefile.am (MODULES): Register it.
* guix/git.scm (ls-remote-refs): New procedure.

Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
---
 Makefile.am         |   1 +
 doc/guix.texi       |  27 ++++++
 guix/git.scm        |  33 +++++++
 guix/import/git.scm | 217 ++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 278 insertions(+)
 create mode 100644 guix/import/git.scm

diff --git a/Makefile.am b/Makefile.am
index 3c79760734..c4d3a456b1 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 36a0c7f5ec..26afb1607a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((tag-prefix . "^release0-")
+      (tag-suffix . "[a-z]?$")
+      (tag-version-delimiter . ":"))))
+@end lisp      
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..c5d0d2da8e 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -56,6 +56,8 @@
             commit-difference
             commit-relation
 
+            ls-remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -556,6 +558,37 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (ls-remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+        (remote-disconnect remote)
+        (repository-close! repository)
+
+        (filter include? (map remote-head-name (remote-ls remote))))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..52c98de197
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,217 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `tag-prefix',
+;;; `tag-suffix' and `tag-version-delimiter' properties of the package to make
+;;; the updater parse the Git tag name correctly.
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+\f
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test"))
+
+(define* (get-version-mapping tags #:key prefix suffix delim pre-releases?)
+  (define (guess-delim)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (display (format #t "total: ~d, dots: ~d, dashes ~d, underscores ~d~%"
+              total dots dashes underscores))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delim))))
+  (define suffix-rx
+    (string-append
+     (or suffix
+         (if pre-releases?
+             (string-append ".*(" (string-join %pre-release-words "|") ").*")
+             ""))
+     "$"))
+  
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (pk delim-rx)
+
+  (define tag-rx
+     (string-append "([[:digit:]][^" delim-rx "[:punct:]]*"
+                    "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                    ;; If there is are no delimiters, it could mean that the
+                    ;; version just contains one number (e.g., "2"), thus, use
+                    ;; "*" instead of "+" to match zero or more numbers.
+                    (if (string=? delim-rx "") "*" "+")
+                    ")" suffix-rx))
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (pk tag)
+      (pk tag-match)
+      (pk tag-rx)
+      (and tag-match
+           (regexp-exec (make-regexp prefix-rx) (match:prefix tag-match))
+           (regexp-substitute/global
+            #f delim-rx (match:substring tag-match)
+            ;; Don't insert "." if there aren't any delimiters in the first
+            ;; place.
+            'pre (if (string=? delim-rx "") "" ".") 'post))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (let ((mapping (fold alist-cons '() (map get-version tags) tags)))
+    (stable-sort! (filter car mapping) entry<?)))
+
+(define* (get-latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest tag available from the Git repository at URL."
+  (define (pre-release? tag)
+    (any (lambda (rx) (regexp-exec (make-regexp rx regexp/icase) tag))
+              %pre-release-words))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (ls-remote-refs url #:tags? #t)))
+         (versions->tags
+          (get-version-mapping (if pre-releases?
+                                   tags
+                                   (filter (negate pre-release?) tags))
+                               #:prefix prefix
+                               #:suffix suffix
+                               #:delim delim
+                               #:pre-releases? pre-releases?)))
+    (display versions->tags)
+    (newline)
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package tag-prefix tag-suffix
+                                tag-version-delimiter refresh-pre-releases?)
+  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, TAG-VERSION-DELIMITER, and
+REFRESH-PRE-RELEASES?  properties of PACKAGE, returns the latest version of
+PACKAGE."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source))))
+      ;;(format #t "~a~%" (package-name package))
+      (get-latest-tag url #:prefix tag-prefix #:suffix tag-suffix
+                      #:delim tag-version-delimiter
+                      #:pre-releases? refresh-pre-releases?))))
+
+(define (git-package? package)
+  "Whether the origin of PACKAGE is a Git repostiory."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (properties (package-properties package))
+         (tag-prefix (assq-ref properties 'tag-prefix))
+         (tag-suffix (assq-ref properties 'tag-suffix))
+         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
+         (refresh-pre-releases? (assq-ref properties 'refresh-pre-releases?))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package
+                                              tag-prefix
+                                              tag-suffix
+                                              tag-version-delimiter
+                                              refresh-pre-releases?)))
+
+    (if new-version
+        (upstream-source
+         (package name)
+         (version new-version)
+         (urls (list url)))
+        ;; No new release or no tags available.
+        #f)))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
-- 
2.33.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-08 18:28             ` Xinglu Chen
@ 2021-09-10  8:36               ` Ludovic Courtès
  2021-09-10 13:23                 ` Xinglu Chen
  0 siblings, 1 reply; 31+ messages in thread
From: Ludovic Courtès @ 2021-09-10  8:36 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: Sarah Morgensen, 50359

Hello,

This looks very cool!

Xinglu Chen <public@yoctocell.xyz> skribis:

> From f924dbb835425f6b9a5796918125592870391405 Mon Sep 17 00:00:00 2001
> Message-Id: <f924dbb835425f6b9a5796918125592870391405.1631125652.git.public@yoctocell.xyz>
> From: Xinglu Chen <public@yoctocell.xyz>
> Date: Fri, 3 Sep 2021 17:50:56 +0200
> Subject: [PATCH] import: Add 'generic-git' updater.
>
> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * Makefile.am (MODULES): Register it.
> * guix/git.scm (ls-remote-refs): New procedure.
>
> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>

Overall LGTM; comments below.

> diff --git a/doc/guix.texi b/doc/guix.texi
> index 36a0c7f5ec..26afb1607a 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
>  @item generic-html
>  a generic updater that crawls the HTML page where the source tarball of
>  the package is hosted, when applicable.
> +@item generic-git

Please add a newline above.

> +@lisp
> +(package
> +  (name "foo")
> +  ;; ...
> +  (properties
> +    '((tag-prefix . "^release0-")
> +      (tag-suffix . "[a-z]?$")
> +      (tag-version-delimiter . ":"))))
> +@end lisp      

Very nice.  Perhaps s/tag-/release-tag-/ for clarity?

> +(define* (ls-remote-refs url #:key tags?)
> +  "Return the list of references advertised at Git repository URL.  If TAGS?
> +is true, limit to only refs/tags."

To remain consistent with existing naming conventions, I’d call it
‘remote-refs’.

> +  (with-libgit2
> +   (call-with-temporary-directory
> +    (lambda (cache-directory)
> +      (let* ((repository (repository-init cache-directory))
> +             ;; Create an in-memory remote so we don't touch disk.
> +             (remote (remote-create-anonymous repository url)))

Too bad we need to create an empty repo; hopefully it costs next to
nothing though.

> +        (remote-connect remote)
> +        (remote-disconnect remote)
> +        (repository-close! repository)
> +
> +        (filter include? (map remote-head-name (remote-ls remote))))))))

Use ‘filter-map’.

> +(define* (get-version-mapping tags #:key prefix suffix delim pre-releases?)

Please add a docstring and remove ‘get-’ from the name.  :-)

> +  (define (guess-delim)
> +    (let ((total (length tags))
> +          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
> +          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
> +          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
> +      (display (format #t "total: ~d, dots: ~d, dashes ~d, underscores ~d~%"
> +              total dots dashes underscores))

Leftover?  (Also display + format.)

Please spell out ‘delimiter’ (info "(guix) Formatting Code").

> +      (cond
> +       ((>= dots (* total 0.35)) ".")
> +       ((>= dashes (* total 0.8)) "-")
> +       ((>= underscores (* total 0.8)) "_")
> +       (else ""))))

That’s a fancy heuristic.  :-)

> +  (let ((mapping (fold alist-cons '() (map get-version tags) tags)))
> +    (stable-sort! (filter car mapping) entry<?)))

It’s perhaps clearer written like this:

  (stable-sort (filter-map (lambda (tag)
                             (let ((version (get-version tag)))
                               (and version (cons version tag))))
                            tags)
               entry<?)

> +(define* (get-latest-tag url #:key prefix suffix delim pre-releases?)
> +  "Return the latest tag available from the Git repository at URL."

Maybe “the tag corresponding to the latest version”.

s/get-latest-tag/latest-tag/

> +  (define (pre-release? tag)
> +    (any (lambda (rx) (regexp-exec (make-regexp rx regexp/icase) tag))
> +              %pre-release-words))

Better call ‘make-regexp’ only once; so you could change
‘%pre-release-words’ to be a list of regexp objects instead of a list of
strings.

> +(define (latest-git-tag-version package tag-prefix tag-suffix
> +                                tag-version-delimiter refresh-pre-releases?)
> +  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, TAG-VERSION-DELIMITER, and
> +REFRESH-PRE-RELEASES?  properties of PACKAGE, returns the latest version of
> +PACKAGE."

Maybe s/refresh-pre-releases?/accept-pre-preleases?/

Since this procedure takes a package, it probably doesn’t need the other
arguments: it can extract them from the package properties, rather than
doing it at the call site.

> +(define (latest-git-release package)
> +  "Return the latest release of PACKAGE."
> +  (let* ((name (package-name package))
> +         (properties (package-properties package))
> +         (tag-prefix (assq-ref properties 'tag-prefix))
> +         (tag-suffix (assq-ref properties 'tag-suffix))
> +         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
> +         (refresh-pre-releases? (assq-ref properties 'refresh-pre-releases?))
> +         (old-version (package-version package))
> +         (url (git-reference-url (origin-uri (package-source package))))
> +         (new-version (latest-git-tag-version package
> +                                              tag-prefix
> +                                              tag-suffix
> +                                              tag-version-delimiter
> +                                              refresh-pre-releases?)))
> +
> +    (if new-version
> +        (upstream-source
> +         (package name)
> +         (version new-version)
> +         (urls (list url)))
> +        ;; No new release or no tags available.
> +        #f)))

Simply: (and new-version (upstream-source …)).

It would have been nice to have tests.  I think testing
‘latest-git-release’ should be feasible without too much hassle using
the (guix tests git) infrastructure, as is done in tests/git.scm, with a
package referring to a locally-created repo using a git-reference with a
file:// URL.

Could you send an updated patch?

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH] import: Add 'generic-git' updater.
  2021-09-10  8:36               ` Ludovic Courtès
@ 2021-09-10 13:23                 ` Xinglu Chen
  0 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-10 13:23 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: Sarah Morgensen, 50359

[-- Attachment #1: Type: text/plain, Size: 6879 bytes --]

On Fri, Sep 10 2021, Ludovic Courtès wrote:

> Hello,
>
> This looks very cool!

Thanks for taking a look!

It’s still a WIP, but I think it’s getting there.  :-)

> Xinglu Chen <public@yoctocell.xyz> skribis:
>
>> From f924dbb835425f6b9a5796918125592870391405 Mon Sep 17 00:00:00 2001
>> Message-Id: <f924dbb835425f6b9a5796918125592870391405.1631125652.git.public@yoctocell.xyz>
>> From: Xinglu Chen <public@yoctocell.xyz>
>> Date: Fri, 3 Sep 2021 17:50:56 +0200
>> Subject: [PATCH] import: Add 'generic-git' updater.
>>
>> * guix/import/git.scm: New file.
>> * doc/guix.texi (Invoking guix refresh): Document it.
>> * Makefile.am (MODULES): Register it.
>> * guix/git.scm (ls-remote-refs): New procedure.
>>
>> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
>
> Overall LGTM; comments below.
>
>> diff --git a/doc/guix.texi b/doc/guix.texi
>> index 36a0c7f5ec..26afb1607a 100644
>> --- a/doc/guix.texi
>> +++ b/doc/guix.texi
>> @@ -11920,6 +11920,33 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
>>  @item generic-html
>>  a generic updater that crawls the HTML page where the source tarball of
>>  the package is hosted, when applicable.
>> +@item generic-git
>
> Please add a newline above.

Noted.

>> +@lisp
>> +(package
>> +  (name "foo")
>> +  ;; ...
>> +  (properties
>> +    '((tag-prefix . "^release0-")
>> +      (tag-suffix . "[a-z]?$")
>> +      (tag-version-delimiter . ":"))))
>> +@end lisp      
>
> Very nice.  Perhaps s/tag-/release-tag-/ for clarity?

Good idea.

>> +(define* (ls-remote-refs url #:key tags?)
>> +  "Return the list of references advertised at Git repository URL.  If TAGS?
>> +is true, limit to only refs/tags."
>
> To remain consistent with existing naming conventions, I’d call it
> ‘remote-refs’.
>
>> +  (with-libgit2
>> +   (call-with-temporary-directory
>> +    (lambda (cache-directory)
>> +      (let* ((repository (repository-init cache-directory))
>> +             ;; Create an in-memory remote so we don't touch disk.
>> +             (remote (remote-create-anonymous repository url)))
>
> Too bad we need to create an empty repo; hopefully it costs next to
> nothing though.
>
>> +        (remote-connect remote)
>> +        (remote-disconnect remote)
>> +        (repository-close! repository)
>> +
>> +        (filter include? (map remote-head-name (remote-ls remote))))))))
>
> Use ‘filter-map’.
>
>> +(define* (get-version-mapping tags #:key prefix suffix delim pre-releases?)
>
> Please add a docstring and remove ‘get-’ from the name.  :-)
>
>> +  (define (guess-delim)
>> +    (let ((total (length tags))
>> +          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
>> +          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
>> +          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
>> +      (display (format #t "total: ~d, dots: ~d, dashes ~d, underscores ~d~%"
>> +              total dots dashes underscores))
>
> Leftover?  (Also display + format.)

Yep.  :-)

> Please spell out ‘delimiter’ (info "(guix) Formatting Code").
>
>> +      (cond
>> +       ((>= dots (* total 0.35)) ".")
>> +       ((>= dashes (* total 0.8)) "-")
>> +       ((>= underscores (* total 0.8)) "_")
>> +       (else ""))))
>
> That’s a fancy heuristic.  :-)

Yeah, it was suggested by Sarah, and in my testing it seems to work
pretty well.  :-)

>> +  (let ((mapping (fold alist-cons '() (map get-version tags) tags)))
>> +    (stable-sort! (filter car mapping) entry<?)))
>
> It’s perhaps clearer written like this:
>
>   (stable-sort (filter-map (lambda (tag)
>                              (let ((version (get-version tag)))
>                                (and version (cons version tag))))
>                             tags)
>                entry<?)

Agreed, I will use your suggested version.

>> +(define* (get-latest-tag url #:key prefix suffix delim pre-releases?)
>> +  "Return the latest tag available from the Git repository at URL."
>
> Maybe “the tag corresponding to the latest version”.

Yeah, as the latest tag might not correspond to a release...

> s/get-latest-tag/latest-tag/
>
>> +  (define (pre-release? tag)
>> +    (any (lambda (rx) (regexp-exec (make-regexp rx regexp/icase) tag))
>> +              %pre-release-words))
>
> Better call ‘make-regexp’ only once; so you could change
> ‘%pre-release-words’ to be a list of regexp objects instead of a list of
> strings.

Noted.

>> +(define (latest-git-tag-version package tag-prefix tag-suffix
>> +                                tag-version-delimiter refresh-pre-releases?)
>> +  "Given a PACKAGE, the TAG-PREFIX, TAG-SUFFIX, TAG-VERSION-DELIMITER, and
>> +REFRESH-PRE-RELEASES?  properties of PACKAGE, returns the latest version of
>> +PACKAGE."
>
> Maybe s/refresh-pre-releases?/accept-pre-preleases?/

‘accept-pre-releases?’ ;-)

> Since this procedure takes a package, it probably doesn’t need the other
> arguments: it can extract them from the package properties, rather than
> doing it at the call site.

Good point.

>> +(define (latest-git-release package)
>> +  "Return the latest release of PACKAGE."
>> +  (let* ((name (package-name package))
>> +         (properties (package-properties package))
>> +         (tag-prefix (assq-ref properties 'tag-prefix))
>> +         (tag-suffix (assq-ref properties 'tag-suffix))
>> +         (tag-version-delimiter (assq-ref properties 'tag-version-delimiter))
>> +         (refresh-pre-releases? (assq-ref properties 'refresh-pre-releases?))
>> +         (old-version (package-version package))
>> +         (url (git-reference-url (origin-uri (package-source package))))
>> +         (new-version (latest-git-tag-version package
>> +                                              tag-prefix
>> +                                              tag-suffix
>> +                                              tag-version-delimiter
>> +                                              refresh-pre-releases?)))
>> +
>> +    (if new-version
>> +        (upstream-source
>> +         (package name)
>> +         (version new-version)
>> +         (urls (list url)))
>> +        ;; No new release or no tags available.
>> +        #f)))
>
> Simply: (and new-version (upstream-source …)).
>
> It would have been nice to have tests.  I think testing
> ‘latest-git-release’ should be feasible without too much hassle using
> the (guix tests git) infrastructure, as is done in tests/git.scm, with a
> package referring to a locally-created repo using a git-reference with a
> file:// URL.

Thanks for the pointers!  I will look into it.

> Could you send an updated patch?

Sure!  Thanks for the review!  :-)


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 0/3] Add 'generic-git' updater.
  2021-09-03 15:50 [bug#50359] [PATCH] import: Add 'generic-git' updater Xinglu Chen
  2021-09-05  0:19 ` Sarah Morgensen
@ 2021-09-10 16:20 ` Xinglu Chen
  2021-09-10 16:21   ` [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
                     ` (3 more replies)
  2021-09-15  8:44 ` [bug#50359] [PATCH 3/3] import: " iskarian
  2 siblings, 4 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-10 16:20 UTC (permalink / raw)
  To: 50359

[-- Attachment #1: Type: text/plain, Size: 1137 bytes --]

Changes since v1:

* Add ‘remote-refs’ procedure to (guix git) (written by Sarah
  Morgensen).  Add tests for it too.

* Make the updater try to guess the delimiter if none was provided (also
  written by Sarah).

* Honor the ‘accept-pre-releases?’ property to include pre-releases when
  looking for tags.

* Various regexp improvements.

* Add tests for the updater.

* Some fixes to (guix tests git).

Xinglu Chen (3):
  tests: git: Don't read from the users global Git config file.
  tests: git: Make 'tag' directive non-interactive.
  import: Add 'generic-git' updater.

 Makefile.am          |   2 +
 doc/guix.texi        |  32 +++++++
 guix/git.scm         |  37 ++++++++
 guix/import/git.scm  | 218 +++++++++++++++++++++++++++++++++++++++++++
 guix/tests/git.scm   |   6 +-
 tests/git.scm        |  26 ++++++
 tests/import-git.scm | 204 ++++++++++++++++++++++++++++++++++++++++
 7 files changed, 523 insertions(+), 2 deletions(-)
 create mode 100644 guix/import/git.scm
 create mode 100644 tests/import-git.scm


base-commit: 9875f9bca3976bf3576eab9be42164fde454597e
-- 
2.33.0




[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file.
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
@ 2021-09-10 16:21   ` Xinglu Chen
  2021-09-10 16:21   ` [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
                     ` (2 subsequent siblings)
  3 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-10 16:21 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

* guix/tests/git (populate-git-repository): Set the GIT_CONFIG_GLOBAL
environment variable to the temporary Git config file.
---
Without this, Git would try to sign the commits when running
tests/git.scm, this was beacuse I had set ‘gpgSign = true’ in
~/.config/git/config.  Setting the environment variable would remove
this impurity.

 guix/tests/git.scm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index b8e5f7e643..e11541e83b 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,6 +54,7 @@ Return DIRECTORY on success."
        (with-environment-variables
         `(("GIT_CONFIG_NOSYSTEM" "1")
           ("GIT_ATTR_NOSYSTEM" "1")
+          ("GIT_CONFIG_GLOBAL" ,(string-append home "/.gitconfig"))
           ("HOME" ,home))
         (apply invoke (git-command) "-C" directory
                command args)))))
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive.
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
  2021-09-10 16:21   ` [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
@ 2021-09-10 16:21   ` Xinglu Chen
  2021-09-13  8:03     ` Ludovic Courtès
  2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
  3 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-10 16:21 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

When running 'git tag TAGNAME', Git will open up the user's default text
editor to make them write a message.  This is not desirable when running
tests.

* guix/tests/git.scm (populate-git-repository): Make the 'tag' directive take
an additional argument, and pass it to the '-m' flag.
---
 guix/tests/git.scm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index e11541e83b..e8d4946e87 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -87,8 +87,8 @@ Return DIRECTORY on success."
       ((('commit text ('signer fingerprint)) rest ...)
        (git "commit" "-m" text (string-append "--gpg-sign=" fingerprint))
        (loop rest))
-      ((('tag name) rest ...)
-       (git "tag" name)
+      ((('tag name text) rest ...)
+       (git "tag" "-m" text name)
        (loop rest))
       ((('branch name) rest ...)
        (git "branch" name)
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
  2021-09-10 16:21   ` [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
  2021-09-10 16:21   ` [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
@ 2021-09-10 16:21   ` Xinglu Chen
  2021-09-13  8:07     ` Ludovic Courtès
  2021-09-16  9:09     ` Sarah Morgensen
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
  3 siblings, 2 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-10 16:21 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

* guix/git.scm (ls-remote-refs): New procedure.
* tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* tests/import-git.scm: New test file.
* Makefile.am (MODULES, SCM_TESTS): Register the new files.

Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
---
 Makefile.am          |   2 +
 doc/guix.texi        |  32 +++++++
 guix/git.scm         |  37 ++++++++
 guix/import/git.scm  | 218 +++++++++++++++++++++++++++++++++++++++++++
 tests/git.scm        |  26 ++++++
 tests/import-git.scm | 204 ++++++++++++++++++++++++++++++++++++++++
 6 files changed, 519 insertions(+)
 create mode 100644 guix/import/git.scm
 create mode 100644 tests/import-git.scm

diff --git a/Makefile.am b/Makefile.am
index dd40a5ad9c..c71d9a29e2 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
@@ -473,6 +474,7 @@ SCM_TESTS =					\
   tests/graph.scm				\
   tests/gremlin.scm				\
   tests/hackage.scm				\
+  tests/import-git.scm				\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 220499503d..dbaa000006 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11921,6 +11921,38 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{release-tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{release-tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{release-tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((release-tag-prefix . "^release0-")
+      (release-tag-suffix . "[a-z]?$")
+      (release-tag-version-delimiter . ":"))))
+@end lisp
+
+By default, the updater will ignore pre-releases; to make it also look
+for pre-releases, set the @code{accept-pre-releases?} property to
+@code{#t}.
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..dc3d3afd02 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -57,6 +57,8 @@
             commit-difference
             commit-relation
 
+            remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -571,6 +573,41 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+        (remote-disconnect remote)
+        (repository-close! repository)
+
+        (filter-map (lambda (remote)
+                      (let ((name (remote-head-name remote)))
+                        (and (include? name)
+                             name)))
+                    (remote-ls remote)))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..b69f9d70f2
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,218 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater
+
+            ;; For tests.
+            latest-git-tag-version))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `release-tag-prefix',
+;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
+;;; package to make the updater parse the Git tag name correctly.
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+\f
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test"))
+
+(define %pre-release-rx
+  (map (cut make-regexp <> regexp/icase) %pre-release-words))
+
+(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
+  "Given a list of Git TAGS, return a association list where the car is the
+version corresponding to the tag, and the cdr is the name of the tag."
+  (define (guess-delimiter)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
+  (define suffix-rx  (string-append (or suffix "") "$"))
+
+  
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (define pre-release-rx
+    (if pre-releases?
+        (string-append ".*(" (string-join %pre-release-words "|") ").*")
+        ""))
+
+  (define tag-rx
+    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
+                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                   ;; If there is are no delimiters, it could mean that the
+                   ;; version just contains one number (e.g., "2"), thus, use
+                   ;; "*" instead of "+" to match zero or more numbers.
+                   (if (string=? delim-rx "") "*" "+")
+                   pre-release-rx ")" suffix-rx))
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (and tag-match
+           (regexp-substitute/global
+            #f delim-rx (match:substring tag-match 1)
+            ;; Don't insert "." if there aren't any delimiters in the first
+            ;; place.
+            'pre (if (string=? delim-rx "") "" ".") 'post))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (stable-sort (filter-map (lambda (tag)
+                             (let ((version (get-version tag)))
+                               (and version (cons version tag))))
+                           tags)
+               entry<?))
+
+(define* (latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest tag available from the Git repository at URL."
+  (define (pre-release? tag)
+    (any (cut regexp-exec <> tag)
+         %pre-release-rx))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (remote-refs url #:tags? #t)))
+         (versions->tags
+          (version-mapping (if pre-releases?
+                               tags
+                               (filter (negate pre-release?) tags))
+                           #:prefix prefix
+                           #:suffix suffix
+                           #:delim delim
+                           #:pre-releases? pre-releases?)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package)
+  "Given a PACKAGE, return the latest version of it, or #f if the latest version
+could not be determined."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source)))
+           (properties (package-properties package))
+           (tag-prefix (assq-ref properties 'release-tag-prefix))
+           (tag-suffix (assq-ref properties 'release-tag-suffix))
+           (tag-version-delimiter (assq-ref properties 'release-tag-version-delimiter))
+           (refresh-pre-releases? (assq-ref properties 'accept-pre-releases?)))
+      (latest-tag url
+                  #:prefix tag-prefix
+                  #:suffix tag-suffix
+                  #:delim tag-version-delimiter
+                  #:pre-releases? refresh-pre-releases?))))
+
+(define (git-package? package)
+  "Whether the origin of PACKAGE is a Git repostiory."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package)))
+
+    (and new-version
+         (upstream-source
+          (package name)
+          (version new-version)
+          (urls (list url))))))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62..1f4fbb9adb 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -161,4 +162,29 @@
               (commit-relation master1 merge)
               (commit-relation merge master1))))))
 
+(test-equal "remote-refs"
+  '("refs/heads/develop" "refs/heads/master"
+    "refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "release-1.0")
+        (branch "develop")
+        (checkout "develop")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "release-1.1"))
+    (remote-refs directory)))
+
+(test-equal "remote-refs: only tags"
+ '("refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "Release 1.0")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "Release 1.1"))
+    (remote-refs directory #:tags? #t)))
+
 (test-end "git")
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 0000000000..9ef724c09c
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,204 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-import-git)
+  #:use-module (git)
+  #:use-module (guix git)
+  #:use-module (guix tests)
+  #:use-module (guix packages)
+  #:use-module (guix import git)
+  #:use-module (guix git-download)
+  #:use-module (guix tests git)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix import git) tools.
+
+(test-begin "git")
+
+(define* (make-package directory version #:optional (properties '()))
+  (dummy-package "test-package"
+    (version version)
+    (properties properties)
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url (string-append "file://" directory))
+             (commit version)))
+       (sha256
+        (base32
+         "0000000000000000000000000000000000000000000000000000"))))))
+
+(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix-1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "prefix-")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1-suffix-123" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-suffix . "-suffix-[0-9]*")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
+  "2021.09.07"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2021-09-07" "Release 2021-09-07"))
+    (let ((package (make-package directory "2021-09-06"
+                                 '((release-tag-version-delimiter . "-")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
+  "20210907"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "20210907" "Release 20210907"))
+    (let ((package (make-package directory "20210906"
+                                 '((release-tag-version-delimiter . "")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: only pre-releases available"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: accept pre-releases"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "version-")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2_0_0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: no tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-equal "latest-git-tag-version: no valid tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Test" "Test tag"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-end "git")
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive.
  2021-09-10 16:21   ` [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
@ 2021-09-13  8:03     ` Ludovic Courtès
  0 siblings, 0 replies; 31+ messages in thread
From: Ludovic Courtès @ 2021-09-13  8:03 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359, Sarah Morgensen

Hello,

Xinglu Chen <public@yoctocell.xyz> skribis:

> When running 'git tag TAGNAME', Git will open up the user's default text
> editor to make them write a message.  This is not desirable when running
> tests.
>
> * guix/tests/git.scm (populate-git-repository): Make the 'tag' directive take
> an additional argument, and pass it to the '-m' flag.

[...]

> -      ((('tag name) rest ...)
> -       (git "tag" name)
> +      ((('tag name text) rest ...)
> +       (git "tag" "-m" text name)

LGTM, but you need to update at least tests/channels.scm accordingly.

Thanks,
Ludo’.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
@ 2021-09-13  8:07     ` Ludovic Courtès
  2021-09-16  9:09     ` Sarah Morgensen
  1 sibling, 0 replies; 31+ messages in thread
From: Ludovic Courtès @ 2021-09-13  8:07 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: 50359, Sarah Morgensen

Xinglu Chen <public@yoctocell.xyz> skribis:

> * guix/git.scm (ls-remote-refs): New procedure.
> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * tests/import-git.scm: New test file.
> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>
> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>

Nice, thanks for writing the tests!

> +++ b/tests/git.scm
> @@ -1,5 +1,6 @@
>  ;;; GNU Guix --- Functional package management for GNU
>  ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
> +;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
>  ;;;
>  ;;; This file is part of GNU Guix.
>  ;;;
> @@ -161,4 +162,29 @@
>                (commit-relation master1 merge)
>                (commit-relation merge master1))))))
>  
> +(test-equal "remote-refs"
> +  '("refs/heads/develop" "refs/heads/master"
> +    "refs/tags/v1.0" "refs/tags/v1.1")
> +  (with-temporary-git-repository directory
> +      '((add "a.txt" "A")
> +        (commit "First commit")
> +        (tag "v1.0" "release-1.0")
> +        (branch "develop")
> +        (checkout "develop")
> +        (add "b.txt" "B")
> +        (commit "Second commit")
> +        (tag "v1.1" "release-1.1"))
> +    (remote-refs directory)))

[...]

> +(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
> +  "1.0.1"
> +  (with-temporary-git-repository directory
> +      '((add "a.txt" "A")
> +        (commit "First commit")
> +        (tag "1.0.1" "Release 1.0.1"))
> +    (let ((package (make-package directory "1.0.0")))
> +      (latest-git-tag-version package))))

I think that for each of these tests that uses the ‘git’ command under
the hood, you’ll need something like what ‘tests/git.scm’ does:

  (unless (which (git-command)) (test-skip 1))
  (test-equal …)

It’d admittedly annoying to have this boilerplate, but I can’t think of
a better solution.

Could you send an updated version?  Then we’ll be all set!

Thank you,
Ludo’.




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-03 15:50 [bug#50359] [PATCH] import: Add 'generic-git' updater Xinglu Chen
  2021-09-05  0:19 ` Sarah Morgensen
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
@ 2021-09-15  8:44 ` iskarian
  2021-09-15 11:59   ` Xinglu Chen
  2 siblings, 1 reply; 31+ messages in thread
From: iskarian @ 2021-09-15  8:44 UTC (permalink / raw)
  To: Xinglu Chen, 50359; +Cc: Ludovic Courtès

Hi,

September 10, 2021 9:21 AM, "Xinglu Chen" <public@yoctocell.xyz> wrote:

> * guix/git.scm (ls-remote-refs): New procedure.
> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * tests/import-git.scm: New test file.
> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
> 
> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>

Overall this is looking good.  Thank you for adding tests (for remote-refs as well!), much appreciated.  It looks like you've done some good polishing.  I see a few nits, which I'll point out in a separate email when I'm not on mobile.  I'll also give it a good test.

But... I've been thinking about the overall approach for a couple days, because I'm not very happy with the complexity of my heuristic.

There can be a lot of weird tags in a repository--look at the one for xf86-video-intel for example.  My heuristic attempts to capture the assumption that repostories tend to move from using "_" or "-" to "." but it does fail to account for moving to or from dates (because dates don't compare with normal versions).

I also realized that we are not using a very useful piece of information--the previous version/tag combo.  I expect that in the vast majority of cases, the version delimiter for the newest version will be the same as the version delimiter for the last known version.  (Perhaps the prefix as well?)  Can we use this information to make our guesses better?  What do you think?

Despite saying all that, it's probably better to not try to get it perfect on the first go--we can always adjust the internals later.  We just want to avoid showing bogus updates.

(Later, I think I'll put together a dataset of tags and current versions to see if I can test how well a particular algorithm works.)

--
Sarah (mobile)




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-15  8:44 ` [bug#50359] [PATCH 3/3] import: " iskarian
@ 2021-09-15 11:59   ` Xinglu Chen
  2021-09-16  9:46     ` Sarah Morgensen
  0 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-15 11:59 UTC (permalink / raw)
  To: iskarian, 50359; +Cc: Ludovic Courtès

[-- Attachment #1: Type: text/plain, Size: 2670 bytes --]

On Wed, Sep 15 2021, iskarian@mgsn.dev wrote:

> Hi,
>
> September 10, 2021 9:21 AM, "Xinglu Chen" <public@yoctocell.xyz> wrote:
>
>> * guix/git.scm (ls-remote-refs): New procedure.
>> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
>> * guix/import/git.scm: New file.
>> * doc/guix.texi (Invoking guix refresh): Document it.
>> * tests/import-git.scm: New test file.
>> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>> 
>> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
>
> Overall this is looking good.  Thank you for adding tests (for
> remote-refs as well!), much appreciated.  It looks like you've done
> some good polishing.  I see a few nits, which I'll point out in a
> separate email when I'm not on mobile.  I'll also give it a good test.
>
> But... I've been thinking about the overall approach for a couple
> days, because I'm not very happy with the complexity of my heuristic.
>
> There can be a lot of weird tags in a repository--look at the one for
> xf86-video-intel for example.  My heuristic attempts to capture the
> assumption that repostories tend to move from using "_" or "-" to "."
> but it does fail to account for moving to or from dates (because dates
> don't compare with normal versions).

But if a repo moved from using versions to tags, or vice-versa, we still
wouldn’t know if say “3.0.1” is newer than “2021.03.02”.  We would have
to know when the “3.0.1” tag was created.

Maybe we could have a ‘release-tag-date-scheme?’ property, that way we
could just try to match dates?

> I also realized that we are not using a very useful piece of
> information--the previous version/tag combo.  I expect that in the
> vast majority of cases, the version delimiter for the newest version
> will be the same as the version delimiter for the last known version.
> (Perhaps the prefix as well?)  Can we use this information to make our
> guesses better?  What do you think?

That sounds like a good idea.  What should happen if the delimiter from
the previous version/tag combo is different from the one that the
‘guess-delimiter’ procedure returns?  Should the one from the previous
version/tag combo take precedence.

> Despite saying all that, it's probably better to not try to get it
> perfect on the first go--we can always adjust the internals later.  We
> just want to avoid showing bogus updates.

Yeah, we can always improve things later.
  
> (Later, I think I'll put together a dataset of tags and current
> versions to see if I can test how well a particular algorithm works.)

Cool, looking forward to that.  :-)

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
  2021-09-13  8:07     ` Ludovic Courtès
@ 2021-09-16  9:09     ` Sarah Morgensen
  2021-09-16 12:48       ` Xinglu Chen
  1 sibling, 1 reply; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-16  9:09 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: Ludovic Courtès, 50359

Hello,

Here are my promised nits.

Xinglu Chen <public@yoctocell.xyz> writes:

> * guix/git.scm (ls-remote-refs): New procedure.
> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
> * guix/import/git.scm: New file.
> * doc/guix.texi (Invoking guix refresh): Document it.
> * tests/import-git.scm: New test file.
> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>
> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>

Again, much thanks for writing tests.

> +@item generic-git
> +a generic updater for packages hosted on Git repositories.  It tries to
> +be smart about parsing Git tag names, but if it is not able to parse the
> +tag name and compare tags correctly, users can define the following
> +properties for a package.
> +
> +@itemize
> +@item @code{release-tag-prefix}: a regular expression for matching a prefix of
> +the tag name.
> +
> +@item @code{release-tag-suffix}: a regular expression for matching a suffix of
> +the tag name.
> +
> +@item @code{release-tag-version-delimiter}: a string used as the delimiter in
> +the tag name for separating the numbers of the version.
> +@end itemize
> +
> +@lisp
> +(package
> +  (name "foo")
> +  ;; ...
> +  (properties
> +    '((release-tag-prefix . "^release0-")
> +      (release-tag-suffix . "[a-z]?$")
> +      (release-tag-version-delimiter . ":"))))
> +@end lisp
> +
> +By default, the updater will ignore pre-releases; to make it also look
> +for pre-releases, set the @code{accept-pre-releases?} property to
> +@code{#t}.

Should this be itemized above?

> +\f
> +;;
> +;;; Remote operations.
> +;;;
> +
> +(define* (remote-refs url #:key tags?)
> +  "Return the list of references advertised at Git repository URL.  If TAGS?
> +is true, limit to only refs/tags."
> +  (define (ref? ref)
> +    ;; Like `git ls-remote --refs', only show actual references.
> +    (and (string-prefix? "refs/" ref)
> +         (not (string-suffix? "^{}" ref))))
> +
> +  (define (tag? ref)
> +    (string-prefix? "refs/tags/" ref))
> +
> +  (define (include? ref)
> +    (and (ref? ref)
> +         (or (not tags?) (tag? ref))))
> +
> +  (with-libgit2
> +   (call-with-temporary-directory
> +    (lambda (cache-directory)
> +      (let* ((repository (repository-init cache-directory))
> +             ;; Create an in-memory remote so we don't touch disk.
> +             (remote (remote-create-anonymous repository url)))
> +        (remote-connect remote)
> +        (remote-disconnect remote)
> +        (repository-close! repository)
> +
> +        (filter-map (lambda (remote)
> +                      (let ((name (remote-head-name remote)))
> +                        (and (include? name)
> +                             name)))
> +                    (remote-ls remote)))))))

I discovered that this can segfault unless 'remote-disconnect' and
possibly 'repository-close!' are called *after* copying the data out.
I've attached a diff for this.

> +\f
> +;;; Updater
> +
> +(define %pre-release-words
> +  '("alpha" "beta" "rc" "dev" "test"))

I found a few packages that use "pre" as well.

> +
> +(define %pre-release-rx
> +  (map (cut make-regexp <> regexp/icase) %pre-release-words))
> +
> +(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
> +  "Given a list of Git TAGS, return a association list where the car is the
                                       ^ an

> +version corresponding to the tag, and the cdr is the name of the tag."
> +  (define (guess-delimiter)
> +    (let ((total (length tags))
> +          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
> +          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
> +          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
> +      (cond
> +       ((>= dots (* total 0.35)) ".")
> +       ((>= dashes (* total 0.8)) "-")
> +       ((>= underscores (* total 0.8)) "_")
> +       (else ""))))
> +
> +  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
> +  (define suffix-rx  (string-append (or suffix "") "$"))
> +
> +  
> +  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
> +  (define pre-release-rx
> +    (if pre-releases?
> +        (string-append ".*(" (string-join %pre-release-words "|") ").*")
> +        ""))
> +
> +  (define tag-rx
> +    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
> +                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
> +                   ;; If there is are no delimiters, it could mean that the
                                  ^ no "is"

> +                   ;; version just contains one number (e.g., "2"), thus, use
> +                   ;; "*" instead of "+" to match zero or more numbers.
> +                   (if (string=? delim-rx "") "*" "+")

Good catch.

> +                   pre-release-rx ")" suffix-rx))
> +
> +  (define (get-version tag)
> +    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
> +      (and tag-match
> +           (regexp-substitute/global
> +            #f delim-rx (match:substring tag-match 1)
> +            ;; Don't insert "." if there aren't any delimiters in the first

Nit: "if there were no delimiters", to be consistent with above comment.

> +            ;; place.
> +            'pre (if (string=? delim-rx "") "" ".") 'post))))

One issue with returning a different delimiter than the package
currently uses is that the automatic updater won't really work as-is.

Hmmm.  When things are modified so the updater gets both the version and
the git-reference, it should be able to reverse-engineer things well
enough there.

I imagine this is really only going to be an issue with dates currently
written as "2017-01-01", anyway.  I'll put my comments on that in reply
to the other email.

> +
> +  (define (entry<? a b)
> +    (eq? (version-compare (car a) (car b)) '<))
> +
> +  (stable-sort (filter-map (lambda (tag)
> +                             (let ((version (get-version tag)))
> +                               (and version (cons version tag))))
> +                           tags)
> +               entry<?))
> +
> +(define* (latest-tag url #:key prefix suffix delim pre-releases?)
> +  "Return the latest tag available from the Git repository at URL."

This returns two values (in preparation for the above-mentioned switch),
so maybe something like "Return the latest version and corresponding tag
available from..."

> +  (define (pre-release? tag)
> +    (any (cut regexp-exec <> tag)
> +         %pre-release-rx))
> +
> +  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))

Should be "cute" so string-length is only evaluated once -- though it's
probably optimized like that anyway.

> +                    (remote-refs url #:tags? #t)))
> +         (versions->tags
> +          (version-mapping (if pre-releases?
> +                               tags
> +                               (filter (negate pre-release?) tags))
> +                           #:prefix prefix
> +                           #:suffix suffix
> +                           #:delim delim
> +                           #:pre-releases? pre-releases?)))
> +    (cond
> +     ((null? tags)
> +      (git-no-tags-error))
> +     ((null? versions->tags)
> +      (git-no-valid-tags-error))
> +     (else
> +      (match (last versions->tags)
> +        ((version . tag)
> +         (values version tag)))))))
> +
> +(define (latest-git-tag-version package)
> +  "Given a PACKAGE, return the latest version of it, or #f if the latest version
> +could not be determined."
> +  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
> +             (warning (or (package-field-location package 'source)
> +                          (package-location package))
> +                      (G_ "~a for ~a~%")
> +                      (condition-message c)
> +                      (package-name package))
> +             #f)
> +            ((eq? (exception-kind c) 'git-error)
> +             (warning (or (package-field-location package 'source)
> +                          (package-location package))
> +                      (G_ "failed to fetch Git repository for ~a~%")
> +                      (package-name package))
> +             #f))
> +    (let* ((source (package-source package))
> +           (url (git-reference-url (origin-uri source)))
> +           (properties (package-properties package))
> +           (tag-prefix (assq-ref properties 'release-tag-prefix))
> +           (tag-suffix (assq-ref properties 'release-tag-suffix))
> +           (tag-version-delimiter (assq-ref properties 'release-tag-version-delimiter))
> +           (refresh-pre-releases? (assq-ref properties 'accept-pre-releases?)))
> +      (latest-tag url
> +                  #:prefix tag-prefix
> +                  #:suffix tag-suffix
> +                  #:delim tag-version-delimiter
> +                  #:pre-releases? refresh-pre-releases?))))

This is entirely a style preference, so only take this suggestion if you
like it :)

    (let* ((source (package-source package))
           (url (git-reference-url (origin-uri source)))
           (property (cute assq-ref (package-properties package) <>)))
      (latest-tag url
                  #:prefix (property 'release-tag-prefix)
                  #:suffix (property 'release-tag-suffix)
                  #:delim (property 'release-tag-version-delimiter)
                  #:pre-releases? (property 'accept-pre-releases?)))))

> +
> +(define (git-package? package)
> +  "Whether the origin of PACKAGE is a Git repostiory."

"Return true if PACKAGE is..."

> +  (match (package-source package)
> +    ((? origin? origin)
> +     (and (eq? (origin-method origin) git-fetch)
> +          (git-reference? (origin-uri origin))))
> +    (_ #f)))
> +
> +(define (latest-git-release package)
> +  "Return the latest release of PACKAGE."

"Return an <upstream-source> for the latest...", to match the other
updaters.

> +  (let* ((name (package-name package))
> +         (old-version (package-version package))
> +         (url (git-reference-url (origin-uri (package-source package))))
> +         (new-version (latest-git-tag-version package)))
> +
> +    (and new-version
> +         (upstream-source
> +          (package name)
> +          (version new-version)
> +          (urls (list url))))))
> +
> +(define %generic-git-updater
> +  (upstream-updater
> +   (name 'generic-git)
> +   (description "Updater for packages hosted on Git repositories")
> +   (pred git-package?)
> +   (latest latest-git-release)))

I tested this updater on all packages in .scm files starting with f
through z, and I found the following packages with possibly bogus
updates:

--8<---------------cut here---------------start------------->8---
javaxom
luakit
ocproxy
pitivi
eid-mw
libhomfly
gnuradio
welle-io
racket-minimal
milkytracker
cl-portal
kodi-cli
openjdk
java-bouncycastle
hurd
opencsg
povray
gpsbabel
go
stepmania
ocaml-mcl

many minetest packages (minetest will have its own updater, though)

ocaml4.07-core-kernel, ocamlbuild and many other ocaml packages
(they seem to be covered by the github updater)
--8<---------------cut here---------------end--------------->8---

The following packages suggest a version -> date update, which may or
may not be bogus:

--8<---------------cut here---------------start------------->8---
cataclysm-dda
autotrace
lbalgtk
nheko
libqalculate
cl-antik
cl-antik-base
cl-hu.dwim.stefil
cl-stefil
cl-gsll
sbcl-cl-gserver
--8<---------------cut here---------------end--------------->8---

--
Sarah




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-15 11:59   ` Xinglu Chen
@ 2021-09-16  9:46     ` Sarah Morgensen
  0 siblings, 0 replies; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-16  9:46 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: Ludovic Courtès, 50359

Hi,

Xinglu Chen <public@yoctocell.xyz> writes:

> On Wed, Sep 15 2021, iskarian@mgsn.dev wrote:
>
>> Hi,
>>
>> September 10, 2021 9:21 AM, "Xinglu Chen" <public@yoctocell.xyz> wrote:
>>
>>> * guix/git.scm (ls-remote-refs): New procedure.
>>> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
>>> * guix/import/git.scm: New file.
>>> * doc/guix.texi (Invoking guix refresh): Document it.
>>> * tests/import-git.scm: New test file.
>>> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>>> 
>>> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
>>
>> Overall this is looking good.  Thank you for adding tests (for
>> remote-refs as well!), much appreciated.  It looks like you've done
>> some good polishing.  I see a few nits, which I'll point out in a
>> separate email when I'm not on mobile.  I'll also give it a good test.
>>
>> But... I've been thinking about the overall approach for a couple
>> days, because I'm not very happy with the complexity of my heuristic.
>>
>> There can be a lot of weird tags in a repository--look at the one for
>> xf86-video-intel for example.  My heuristic attempts to capture the
>> assumption that repostories tend to move from using "_" or "-" to "."
>> but it does fail to account for moving to or from dates (because dates
>> don't compare with normal versions).
>
> But if a repo moved from using versions to tags, or vice-versa, we still
> wouldn’t know if say “3.0.1” is newer than “2021.03.02”.  We would have
> to know when the “3.0.1” tag was created.

You're right; I thought of that afterwards.

> Maybe we could have a ‘release-tag-date-scheme?’ property, that way we
> could just try to match dates?

That seems like it might be the only way to handle it in some cases (if
they have both versions and dates with a "." delimiter).  (Though, we
are actually interested in the *lack* of a date scheme.  If they use a
date scheme now, other versions will be disregarded, so we're fine; but
if they use versions now and used a date scheme before, the versions
will be discarded.)

>> I also realized that we are not using a very useful piece of
>> information--the previous version/tag combo.  I expect that in the
>> vast majority of cases, the version delimiter for the newest version
>> will be the same as the version delimiter for the last known version.
>> (Perhaps the prefix as well?)  Can we use this information to make our
>> guesses better?  What do you think?
>
> That sounds like a good idea.  What should happen if the delimiter from
> the previous version/tag combo is different from the one that the
> ‘guess-delimiter’ procedure returns?  Should the one from the previous
> version/tag combo take precedence.

Consider:

  prefix := 'tag-prefix or guess-prefix-from-current-version+tag or default
  delim := 'tag-delim or guess-delim-from-current-version+tag or guess-delimiter
  suffix := 'tag-suffix or default

This should cover:

  1. Format stayed the same (including date formats)
  2. Format changed from (git-version ...) to proper version

This does not otherwise cover a complete change in format, such as "_"
-> ".", date(-) -> version, or version -> date(.), for which I could
argue requiring a manual update is reasonable.  It also does not cover
when the tags have both versions and dates with the same delimiter.

Though it would be nice to see when such updates are available, is it
worth some bogus results?  Are false positives better or false negatives
better?

Unless you/we want to pursue one or both of the above changes now, the
latest patch LGTM (modulo my nits).

Thanks for your work,
--
Sarah




^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-16  9:09     ` Sarah Morgensen
@ 2021-09-16 12:48       ` Xinglu Chen
  2021-09-16 23:42         ` Sarah Morgensen
  0 siblings, 1 reply; 31+ messages in thread
From: Xinglu Chen @ 2021-09-16 12:48 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: Ludovic Courtès, 50359

[-- Attachment #1: Type: text/plain, Size: 18647 bytes --]

On Thu, Sep 16 2021, Sarah Morgensen wrote:

> Hi,
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> On Wed, Sep 15 2021, iskarian@mgsn.dev wrote:
>>
>>> Hi,
>>>
>>> September 10, 2021 9:21 AM, "Xinglu Chen" <public@yoctocell.xyz> wrote:
>>>
>>>> * guix/git.scm (ls-remote-refs): New procedure.
>>>> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
>>>> * guix/import/git.scm: New file.
>>>> * doc/guix.texi (Invoking guix refresh): Document it.
>>>> * tests/import-git.scm: New test file.
>>>> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>>>> 
>>>> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
>>>
>>> Overall this is looking good.  Thank you for adding tests (for
>>> remote-refs as well!), much appreciated.  It looks like you've done
>>> some good polishing.  I see a few nits, which I'll point out in a
>>> separate email when I'm not on mobile.  I'll also give it a good test.
>>>
>>> But... I've been thinking about the overall approach for a couple
>>> days, because I'm not very happy with the complexity of my heuristic.
>>>
>>> There can be a lot of weird tags in a repository--look at the one for
>>> xf86-video-intel for example.  My heuristic attempts to capture the
>>> assumption that repostories tend to move from using "_" or "-" to "."
>>> but it does fail to account for moving to or from dates (because dates
>>> don't compare with normal versions).
>>
>> But if a repo moved from using versions to tags, or vice-versa, we still
>> wouldn’t know if say “3.0.1” is newer than “2021.03.02”.  We would have
>> to know when the “3.0.1” tag was created.
>
> You're right; I thought of that afterwards.
>
>> Maybe we could have a ‘release-tag-date-scheme?’ property, that way we
>> could just try to match dates?
>
> That seems like it might be the only way to handle it in some cases (if
> they have both versions and dates with a "." delimiter).

It doesn’t have to be “.” delimiter though; if they both have the same
delimiter it would be difficult to distinguish a version from a date,
e.g., “1-2-3” vs “2021-03-23”.

> (Though, we are actually interested in the *lack* of a date scheme.
> If they use a date scheme now, other versions will be disregarded, so
> we're fine; but if they use versions now and used a date scheme
> before, the versions will be discarded.)

I am not sure what you are trying to say, could you elaborate?

>>> I also realized that we are not using a very useful piece of
>>> information--the previous version/tag combo.  I expect that in the
>>> vast majority of cases, the version delimiter for the newest version
>>> will be the same as the version delimiter for the last known version.
>>> (Perhaps the prefix as well?)  Can we use this information to make our
>>> guesses better?  What do you think?
>>
>> That sounds like a good idea.  What should happen if the delimiter from
>> the previous version/tag combo is different from the one that the
>> ‘guess-delimiter’ procedure returns?  Should the one from the previous
>> version/tag combo take precedence.
>
> Consider:
>
>   prefix := 'tag-prefix or guess-prefix-from-current-version+tag or default
>   delim := 'tag-delim or guess-delim-from-current-version+tag or guess-delimiter
>   suffix := 'tag-suffix or default
>
> This should cover:
>
>   1. Format stayed the same (including date formats)
>   2. Format changed from (git-version ...) to proper version
>
> This does not otherwise cover a complete change in format, such as "_"
> -> ".", date(-) -> version, or version -> date(.), for which I could
> argue requiring a manual update is reasonable.

Yeah, it’s not really possible to automatically detect those kind of
changes.

> It also does not cover when the tags have both versions and dates with
> the same delimiter.
>
> Though it would be nice to see when such updates are available, is it
> worth some bogus results?  Are false positives better or false negatives
> better?

Hmm, good question!  If in the future we have some kind of bot that
automatically runs ‘guix refresh -u’, builds the updated package, and
send a patch to the mailing list, not having false positives might be
more important.  We could also have a ‘disable-tag-updater?’ property to
disable the updater for packages which gives false positive, or maybe
that will result in to many properties.

> Unless you/we want to pursue one or both of the above changes now, the
> latest patch LGTM (modulo my nits).

I would prefer to wait a bit with the improvements mentioned above.  The
current patch has been in the works a week or two already, so it’s
probably a good idea to get it merged, and try to solve the less
important issues later.  :-)

> Thanks for your work,

You are welcome!  And thanks for taking the time to test and review the
work.


On Thu, Sep 16 2021, Sarah Morgensen wrote (again):

> Hello,
>
> Here are my promised nits.
>
> Xinglu Chen <public@yoctocell.xyz> writes:
>
>> * guix/git.scm (ls-remote-refs): New procedure.
>> * tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
>> * guix/import/git.scm: New file.
>> * doc/guix.texi (Invoking guix refresh): Document it.
>> * tests/import-git.scm: New test file.
>> * Makefile.am (MODULES, SCM_TESTS): Register the new files.
>>
>> Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
>
> Again, much thanks for writing tests.
>
>> +@item generic-git
>> +a generic updater for packages hosted on Git repositories.  It tries to
>> +be smart about parsing Git tag names, but if it is not able to parse the
>> +tag name and compare tags correctly, users can define the following
>> +properties for a package.
>> +
>> +@itemize
>> +@item @code{release-tag-prefix}: a regular expression for matching a prefix of
>> +the tag name.
>> +
>> +@item @code{release-tag-suffix}: a regular expression for matching a suffix of
>> +the tag name.
>> +
>> +@item @code{release-tag-version-delimiter}: a string used as the delimiter in
>> +the tag name for separating the numbers of the version.
>> +@end itemize
>> +
>> +@lisp
>> +(package
>> +  (name "foo")
>> +  ;; ...
>> +  (properties
>> +    '((release-tag-prefix . "^release0-")
>> +      (release-tag-suffix . "[a-z]?$")
>> +      (release-tag-version-delimiter . ":"))))
>> +@end lisp
>> +
>> +By default, the updater will ignore pre-releases; to make it also look
>> +for pre-releases, set the @code{accept-pre-releases?} property to
>> +@code{#t}.
>
> Should this be itemized above?

That’s probably a good idea, since it is related to how the tag will be
parsed.

>> +\f
>> +;;
>> +;;; Remote operations.
>> +;;;
>> +
>> +(define* (remote-refs url #:key tags?)
>> +  "Return the list of references advertised at Git repository URL.  If TAGS?
>> +is true, limit to only refs/tags."
>> +  (define (ref? ref)
>> +    ;; Like `git ls-remote --refs', only show actual references.
>> +    (and (string-prefix? "refs/" ref)
>> +         (not (string-suffix? "^{}" ref))))
>> +
>> +  (define (tag? ref)
>> +    (string-prefix? "refs/tags/" ref))
>> +
>> +  (define (include? ref)
>> +    (and (ref? ref)
>> +         (or (not tags?) (tag? ref))))
>> +
>> +  (with-libgit2
>> +   (call-with-temporary-directory
>> +    (lambda (cache-directory)
>> +      (let* ((repository (repository-init cache-directory))
>> +             ;; Create an in-memory remote so we don't touch disk.
>> +             (remote (remote-create-anonymous repository url)))
>> +        (remote-connect remote)
>> +        (remote-disconnect remote)
>> +        (repository-close! repository)
>> +
>> +        (filter-map (lambda (remote)
>> +                      (let ((name (remote-head-name remote)))
>> +                        (and (include? name)
>> +                             name)))
>> +                    (remote-ls remote)))))))
>
> I discovered that this can segfault unless 'remote-disconnect' and
> possibly 'repository-close!' are called *after* copying the data out.
> I've attached a diff for this.

I don’t see a diff attached; maybe you forgot?  :-)

>> +\f
>> +;;; Updater
>> +
>> +(define %pre-release-words
>> +  '("alpha" "beta" "rc" "dev" "test"))
>
> I found a few packages that use "pre" as well.

Good catch, I noticed that as well when doing some more testing.

>> +
>> +(define %pre-release-rx
>> +  (map (cut make-regexp <> regexp/icase) %pre-release-words))
>> +
>> +(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
>> +  "Given a list of Git TAGS, return a association list where the car is the
>                                        ^ an
>
>> +version corresponding to the tag, and the cdr is the name of the tag."
>> +  (define (guess-delimiter)
>> +    (let ((total (length tags))
>> +          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
>> +          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
>> +          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
>> +      (cond
>> +       ((>= dots (* total 0.35)) ".")
>> +       ((>= dashes (* total 0.8)) "-")
>> +       ((>= underscores (* total 0.8)) "_")
>> +       (else ""))))
>> +
>> +  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
>> +  (define suffix-rx  (string-append (or suffix "") "$"))
>> +
>> +  
>> +  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
>> +  (define pre-release-rx
>> +    (if pre-releases?
>> +        (string-append ".*(" (string-join %pre-release-words "|") ").*")
>> +        ""))
>> +
>> +  (define tag-rx
>> +    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
>> +                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
>> +                   ;; If there is are no delimiters, it could mean that the
>                                   ^ no "is"
>
>> +                   ;; version just contains one number (e.g., "2"), thus, use
>> +                   ;; "*" instead of "+" to match zero or more numbers.
>> +                   (if (string=? delim-rx "") "*" "+")
>
> Good catch.
>
>> +                   pre-release-rx ")" suffix-rx))
>> +
>> +  (define (get-version tag)
>> +    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
>> +      (and tag-match
>> +           (regexp-substitute/global
>> +            #f delim-rx (match:substring tag-match 1)
>> +            ;; Don't insert "." if there aren't any delimiters in the first
>
> Nit: "if there were no delimiters", to be consistent with above comment.

Noted.

>> +            ;; place.
>> +            'pre (if (string=? delim-rx "") "" ".") 'post))))
>
> One issue with returning a different delimiter than the package
> currently uses is that the automatic updater won't really work as-is.

Good point;, the tag name would be incorrect in those cases.

> Hmmm.  When things are modified so the updater gets both the version and
> the git-reference, it should be able to reverse-engineer things well
> enough there.

Ah, looks like (guix upstream) needs some work.  :-)

> I imagine this is really only going to be an issue with dates currently
> written as "2017-01-01", anyway.  I'll put my comments on that in reply
> to the other email.
>
>> +
>> +  (define (entry<? a b)
>> +    (eq? (version-compare (car a) (car b)) '<))
>> +
>> +  (stable-sort (filter-map (lambda (tag)
>> +                             (let ((version (get-version tag)))
>> +                               (and version (cons version tag))))
>> +                           tags)
>> +               entry<?))
>> +
>> +(define* (latest-tag url #:key prefix suffix delim pre-releases?)
>> +  "Return the latest tag available from the Git repository at URL."
>
> This returns two values (in preparation for the above-mentioned switch),
> so maybe something like "Return the latest version and corresponding tag
> available from..."

Good catch.

>> +  (define (pre-release? tag)
>> +    (any (cut regexp-exec <> tag)
>> +         %pre-release-rx))
>> +
>> +  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
>
> Should be "cute" so string-length is only evaluated once -- though it's
> probably optimized like that anyway.

Good catch, I keep forgetting that ‘cute’ exists.  :-)

>> +                    (remote-refs url #:tags? #t)))
>> +         (versions->tags
>> +          (version-mapping (if pre-releases?
>> +                               tags
>> +                               (filter (negate pre-release?) tags))
>> +                           #:prefix prefix
>> +                           #:suffix suffix
>> +                           #:delim delim
>> +                           #:pre-releases? pre-releases?)))
>> +    (cond
>> +     ((null? tags)
>> +      (git-no-tags-error))
>> +     ((null? versions->tags)
>> +      (git-no-valid-tags-error))
>> +     (else
>> +      (match (last versions->tags)
>> +        ((version . tag)
>> +         (values version tag)))))))
>> +
>> +(define (latest-git-tag-version package)
>> +  "Given a PACKAGE, return the latest version of it, or #f if the latest version
>> +could not be determined."
>> +  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
>> +             (warning (or (package-field-location package 'source)
>> +                          (package-location package))
>> +                      (G_ "~a for ~a~%")
>> +                      (condition-message c)
>> +                      (package-name package))
>> +             #f)
>> +            ((eq? (exception-kind c) 'git-error)
>> +             (warning (or (package-field-location package 'source)
>> +                          (package-location package))
>> +                      (G_ "failed to fetch Git repository for ~a~%")
>> +                      (package-name package))
>> +             #f))
>> +    (let* ((source (package-source package))
>> +           (url (git-reference-url (origin-uri source)))
>> +           (properties (package-properties package))
>> +           (tag-prefix (assq-ref properties 'release-tag-prefix))
>> +           (tag-suffix (assq-ref properties 'release-tag-suffix))
>> +           (tag-version-delimiter (assq-ref properties 'release-tag-version-delimiter))
>> +           (refresh-pre-releases? (assq-ref properties 'accept-pre-releases?)))
>> +      (latest-tag url
>> +                  #:prefix tag-prefix
>> +                  #:suffix tag-suffix
>> +                  #:delim tag-version-delimiter
>> +                  #:pre-releases? refresh-pre-releases?))))
>
> This is entirely a style preference, so only take this suggestion if you
> like it :)
>
>     (let* ((source (package-source package))
>            (url (git-reference-url (origin-uri source)))
>            (property (cute assq-ref (package-properties package) <>)))
>       (latest-tag url
>                   #:prefix (property 'release-tag-prefix)
>                   #:suffix (property 'release-tag-suffix)
>                   #:delim (property 'release-tag-version-delimiter)
>                   #:pre-releases? (property 'accept-pre-releases?)))))

That does look cleaner, thanks for the suggestion!

>> +
>> +(define (git-package? package)
>> +  "Whether the origin of PACKAGE is a Git repostiory."
>
> "Return true if PACKAGE is..."

“PACKAGE is a Git repository.” doesn’t really sound right, maybe “if
PACKAGE is hosted on a Git repository”?

>> +  (match (package-source package)
>> +    ((? origin? origin)
>> +     (and (eq? (origin-method origin) git-fetch)
>> +          (git-reference? (origin-uri origin))))
>> +    (_ #f)))
>> +
>> +(define (latest-git-release package)
>> +  "Return the latest release of PACKAGE."
>
> "Return an <upstream-source> for the latest...", to match the other
> updaters.
>
>> +  (let* ((name (package-name package))
>> +         (old-version (package-version package))
>> +         (url (git-reference-url (origin-uri (package-source package))))
>> +         (new-version (latest-git-tag-version package)))
>> +
>> +    (and new-version
>> +         (upstream-source
>> +          (package name)
>> +          (version new-version)
>> +          (urls (list url))))))
>> +
>> +(define %generic-git-updater
>> +  (upstream-updater
>> +   (name 'generic-git)
>> +   (description "Updater for packages hosted on Git repositories")
>> +   (pred git-package?)
>> +   (latest latest-git-release)))
>
> I tested this updater on all packages in .scm files starting with f
> through z, and I found the following packages with possibly bogus
> updates:
>
> --8<---------------cut here---------------start------------->8---
> javaxom

I assume you meant ‘java-xom’  :-)

That’s a weird scheme; setting the delimiter to “.” doesn’t help since
it thinks that “127” is greater than “1.3.7”.

> luakit
> ocproxy
> pitivi

‘pitivi’ has a pretty weird version string to begin with; it may be
better to change it to the date: “0.999.0-2021-05.0” -> “2021-05.0”.

> eid-mw
> libhomfly
> gnuradio
> welle-io

Setting the delimiter to "." fixes the issue.

> racket-minimal

Setting the prefix to "v" fixes this.

> milkytracker
> cl-portal
> kodi-cli
> openjdk
> java-bouncycastle
> hurd
> opencsg

Setting the suffix to "-release" fixes this.

> povray
> gpsbabel

Setting the prefix to "gpsbabel_" fixes this.

> go
> stepmania
> ocaml-mcl
>
> many minetest packages (minetest will have its own updater, though)
>
> ocaml4.07-core-kernel, ocamlbuild and many other ocaml packages
> (they seem to be covered by the github updater)
> --8<---------------cut here---------------end--------------->8---

Hmm, ‘guix refresh’ says that ‘ocamlbuild’ is already the latest
version.  But you are right, many of the packages are already taken care
of by the ‘github’ updater.

> The following packages suggest a version -> date update, which may or
> may not be bogus:
>
> --8<---------------cut here---------------start------------->8---
> cataclysm-dda
> autotrace
> lbalgtk
> nheko
> libqalculate
> cl-antik
> cl-antik-base
> cl-hu.dwim.stefil
> cl-stefil
> cl-gsll
> sbcl-cl-gserver
> --8<---------------cut here---------------end--------------->8---

Thanks for taking the time to find these false positive!

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-16 12:48       ` Xinglu Chen
@ 2021-09-16 23:42         ` Sarah Morgensen
  2021-09-17  7:48           ` Xinglu Chen
  0 siblings, 1 reply; 31+ messages in thread
From: Sarah Morgensen @ 2021-09-16 23:42 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: Ludovic Courtès, 50359

[-- Attachment #1: Type: text/plain, Size: 5293 bytes --]

Xinglu Chen <public@yoctocell.xyz> writes:

>>> Maybe we could have a ‘release-tag-date-scheme?’ property, that way we
>>> could just try to match dates?
>>
>> That seems like it might be the only way to handle it in some cases (if
>> they have both versions and dates with a "." delimiter).
>
> It doesn’t have to be “.” delimiter though; if they both have the same
> delimiter it would be difficult to distinguish a version from a date,
> e.g., “1-2-3” vs “2021-03-23”.

Sure, but I haven't seen the former :)

>> (Though, we are actually interested in the *lack* of a date scheme.
>> If they use a date scheme now, other versions will be disregarded, so
>> we're fine; but if they use versions now and used a date scheme
>> before, the versions will be discarded.)
>
> I am not sure what you are trying to say, could you elaborate?

Just that the important case is disallowing dates when
'release-tag-date-scheme? is #f.

If the tags of a repo are:

12.1
12.2
13.0
13.4
2018.01.01
2018.05.05

and we do nothing, the 2018.05.05 tag will be selected.  This is correct
if we do want dates, but incorrect if we don't (in which case we would
set 'tag-version-date-scheme? to #f to get the correct result).

>> Though it would be nice to see when such updates are available, is it
>> worth some bogus results?  Are false positives better or false negatives
>> better?
>
> Hmm, good question!  If in the future we have some kind of bot that
> automatically runs ‘guix refresh -u’, builds the updated package, and
> send a patch to the mailing list, not having false positives might be
> more important.  We could also have a ‘disable-tag-updater?’ property to
> disable the updater for packages which gives false positive, or maybe
> that will result in to many properties.

For these packages, it would probably easier to just use the existing
tag- properties.  In fact, instead of this or the date-scheme above,
a 'tag-version-regex' would cover both cases.

In fact, we could replace 'tag-version-delimiter' with
'tag-version-regex' and instead provide convencience functions such as
(untested):

(define (version-regex delim)
  (let ((delim-rx (regexp-quote delim)))
    (string-append "([[:digit:]][^" delim-rx "[:punct:]]*"
                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
                   (if (string=? delim-rx "") "*" "+"))))

(define* (version-date-regex (delim "."))
  (let ((delim-rx (regexp-quote delim)))
    (string-append "([0-9]{4}" delim-rx "(0[1-9]|11|12)"
                   delim-rx "(0[1-9]|[1-2][0-9])")))

WDYT?

>> Unless you/we want to pursue one or both of the above changes now, the
>> latest patch LGTM (modulo my nits).
>
> I would prefer to wait a bit with the improvements mentioned above.  The
> current patch has been in the works a week or two already, so it’s
> probably a good idea to get it merged, and try to solve the less
> important issues later.  :-)

Sounds good to me, then!

>> I discovered that this can segfault unless 'remote-disconnect' and
>> possibly 'repository-close!' are called *after* copying the data out.
>> I've attached a diff for this.
>
> I don’t see a diff attached; maybe you forgot?  :-)
>

I've actually attached it this time :)

>>> +
>>> +(define (git-package? package)
>>> +  "Whether the origin of PACKAGE is a Git repostiory."
>>
>> "Return true if PACKAGE is..."
>
> “PACKAGE is a Git repository.” doesn’t really sound right, maybe “if
> PACKAGE is hosted on a Git repository”?'

Sorry, yes, that's what I meant, or "Return true if the origin..."; I
was just suggesting making it a full sentence.

>> I tested this updater on all packages in .scm files starting with f
>> through z, and I found the following packages with possibly bogus
>> updates:
>>
>> --8<---------------cut here---------------start------------->8---
>> javaxom
>
> I assume you meant ‘java-xom’  :-)
>
> That’s a weird scheme; setting the delimiter to “.” doesn’t help since
> it thinks that “127” is greater than “1.3.7”.

'tag-version-regex would allow fixing this ;)

>
>> luakit
>> ocproxy
>> pitivi
>
> ‘pitivi’ has a pretty weird version string to begin with; it may be
> better to change it to the date: “0.999.0-2021-05.0” -> “2021-05.0”.
>
>> eid-mw
>> libhomfly
>> gnuradio
>> welle-io
>
> Setting the delimiter to "." fixes the issue.
>
>> racket-minimal
>
> Setting the prefix to "v" fixes this.
>
>> milkytracker
>> cl-portal
>> kodi-cli
>> openjdk
>> java-bouncycastle
>> hurd
>> opencsg
>
> Setting the suffix to "-release" fixes this.
>
>> povray
>> gpsbabel
>
> Setting the prefix to "gpsbabel_" fixes this.
>
>> go
>> stepmania
>> ocaml-mcl
>>
>> many minetest packages (minetest will have its own updater, though)
>>
>> ocaml4.07-core-kernel, ocamlbuild and many other ocaml packages
>> (they seem to be covered by the github updater)
>> --8<---------------cut here---------------end--------------->8---

I'm glad to see that these are easily fixed with the properties, though!
That's some good validation.

Now I just have to give the (guix upstream) some attention...

--
Sarah


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Fix undeterministic segfaults in remote-refs. --]
[-- Type: text/x-patch, Size: 1291 bytes --]

diff --git a/guix/git.scm b/guix/git.scm
index dc3d3afd02..bbff4fc890 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -593,6 +593,11 @@ is true, limit to only refs/tags."
     (and (ref? ref)
          (or (not tags?) (tag? ref))))
 
+  (define (remote-head->ref remote)
+    (let ((name (remote-head-name remote)))
+      (and (include? name)
+           name)))
+
   (with-libgit2
    (call-with-temporary-directory
     (lambda (cache-directory)
@@ -600,14 +605,13 @@ is true, limit to only refs/tags."
              ;; Create an in-memory remote so we don't touch disk.
              (remote (remote-create-anonymous repository url)))
         (remote-connect remote)
-        (remote-disconnect remote)
-        (repository-close! repository)
-
-        (filter-map (lambda (remote)
-                      (let ((name (remote-head-name remote)))
-                        (and (include? name)
-                             name)))
-                    (remote-ls remote)))))))
+
+        (let* ((remote-heads (remote-ls remote))
+               (refs (filter-map remote-head->ref remote-heads)))
+          ;; Wait until we're finished with the repository before closing it.
+          (remote-disconnect remote)
+          (repository-close! repository)
+          refs))))))
 
 \f
 ;;;

^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater.
  2021-09-16 23:42         ` Sarah Morgensen
@ 2021-09-17  7:48           ` Xinglu Chen
  0 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-17  7:48 UTC (permalink / raw)
  To: Sarah Morgensen; +Cc: Ludovic Courtès, 50359

[-- Attachment #1: Type: text/plain, Size: 7109 bytes --]

On Thu, Sep 16 2021, Sarah Morgensen wrote:

> Xinglu Chen <public@yoctocell.xyz> writes:
>
>>>> Maybe we could have a ‘release-tag-date-scheme?’ property, that way we
>>>> could just try to match dates?
>>>
>>> That seems like it might be the only way to handle it in some cases (if
>>> they have both versions and dates with a "." delimiter).
>>
>> It doesn’t have to be “.” delimiter though; if they both have the same
>> delimiter it would be difficult to distinguish a version from a date,
>> e.g., “1-2-3” vs “2021-03-23”.
>
> Sure, but I haven't seen the former :)
>
>>> (Though, we are actually interested in the *lack* of a date scheme.
>>> If they use a date scheme now, other versions will be disregarded, so
>>> we're fine; but if they use versions now and used a date scheme
>>> before, the versions will be discarded.)
>>
>> I am not sure what you are trying to say, could you elaborate?
>
> Just that the important case is disallowing dates when
> 'release-tag-date-scheme? is #f.
>
> If the tags of a repo are:
>
> 12.1
> 12.2
> 13.0
> 13.4
> 2018.01.01
> 2018.05.05
>
> and we do nothing, the 2018.05.05 tag will be selected.  This is correct
> if we do want dates, but incorrect if we don't (in which case we would
> set 'tag-version-date-scheme? to #f to get the correct result).

Ah, that makes sense.  :-)

>>> Though it would be nice to see when such updates are available, is it
>>> worth some bogus results?  Are false positives better or false negatives
>>> better?
>>
>> Hmm, good question!  If in the future we have some kind of bot that
>> automatically runs ‘guix refresh -u’, builds the updated package, and
>> send a patch to the mailing list, not having false positives might be
>> more important.  We could also have a ‘disable-tag-updater?’ property to
>> disable the updater for packages which gives false positive, or maybe
>> that will result in to many properties.
>
> For these packages, it would probably easier to just use the existing
> tag- properties.  In fact, instead of this or the date-scheme above,
> a 'tag-version-regex' would cover both cases.
>
> In fact, we could replace 'tag-version-delimiter' with
> 'tag-version-regex' and instead provide convencience functions such as
> (untested):
>
> (define (version-regex delim)
>   (let ((delim-rx (regexp-quote delim)))
>     (string-append "([[:digit:]][^" delim-rx "[:punct:]]*"
>                    "(" delim-rx "[^[:punct:]" delim-rx "]+)"
>                    (if (string=? delim-rx "") "*" "+"))))
>
> (define* (version-date-regex (delim "."))
>   (let ((delim-rx (regexp-quote delim)))
>     (string-append "([0-9]{4}" delim-rx "(0[1-9]|11|12)"
>                    delim-rx "(0[1-9]|[1-2][0-9])")))
>
> WDYT?

That sounds like a good idea!  Where would we put these procedures,
(guix packages)?

>>> Unless you/we want to pursue one or both of the above changes now, the
>>> latest patch LGTM (modulo my nits).
>>
>> I would prefer to wait a bit with the improvements mentioned above.  The
>> current patch has been in the works a week or two already, so it’s
>> probably a good idea to get it merged, and try to solve the less
>> important issues later.  :-)
>
> Sounds good to me, then!
>
>>> I discovered that this can segfault unless 'remote-disconnect' and
>>> possibly 'repository-close!' are called *after* copying the data out.
>>> I've attached a diff for this.
>>
>> I don’t see a diff attached; maybe you forgot?  :-)
>>
>
> I've actually attached it this time :)
>
>>>> +
>>>> +(define (git-package? package)
>>>> +  "Whether the origin of PACKAGE is a Git repostiory."
>>>
>>> "Return true if PACKAGE is..."
>>
>> “PACKAGE is a Git repository.” doesn’t really sound right, maybe “if
>> PACKAGE is hosted on a Git repository”?'
>
> Sorry, yes, that's what I meant, or "Return true if the origin..."; I
> was just suggesting making it a full sentence.
>
>>> I tested this updater on all packages in .scm files starting with f
>>> through z, and I found the following packages with possibly bogus
>>> updates:
>>>
>>> --8<---------------cut here---------------start------------->8---
>>> javaxom
>>
>> I assume you meant ‘java-xom’  :-)
>>
>> That’s a weird scheme; setting the delimiter to “.” doesn’t help since
>> it thinks that “127” is greater than “1.3.7”.
>
> 'tag-version-regex would allow fixing this ;)
>
>>
>>> luakit
>>> ocproxy
>>> pitivi
>>
>> ‘pitivi’ has a pretty weird version string to begin with; it may be
>> better to change it to the date: “0.999.0-2021-05.0” -> “2021-05.0”.
>>
>>> eid-mw
>>> libhomfly
>>> gnuradio
>>> welle-io
>>
>> Setting the delimiter to "." fixes the issue.
>>
>>> racket-minimal
>>
>> Setting the prefix to "v" fixes this.
>>
>>> milkytracker
>>> cl-portal
>>> kodi-cli
>>> openjdk
>>> java-bouncycastle
>>> hurd
>>> opencsg
>>
>> Setting the suffix to "-release" fixes this.
>>
>>> povray
>>> gpsbabel
>>
>> Setting the prefix to "gpsbabel_" fixes this.
>>
>>> go
>>> stepmania
>>> ocaml-mcl
>>>
>>> many minetest packages (minetest will have its own updater, though)
>>>
>>> ocaml4.07-core-kernel, ocamlbuild and many other ocaml packages
>>> (they seem to be covered by the github updater)
>>> --8<---------------cut here---------------end--------------->8---
>
> I'm glad to see that these are easily fixed with the properties, though!
> That's some good validation.

Yeah, it’s looking pretty good.  :-)

> Now I just have to give the (guix upstream) some attention...
>
> --
> Sarah
>
> diff --git a/guix/git.scm b/guix/git.scm
> index dc3d3afd02..bbff4fc890 100644
> --- a/guix/git.scm
> +++ b/guix/git.scm
> @@ -593,6 +593,11 @@ is true, limit to only refs/tags."
>      (and (ref? ref)
>           (or (not tags?) (tag? ref))))
>  
> +  (define (remote-head->ref remote)
> +    (let ((name (remote-head-name remote)))
> +      (and (include? name)
> +           name)))
> +
>    (with-libgit2
>     (call-with-temporary-directory
>      (lambda (cache-directory)
> @@ -600,14 +605,13 @@ is true, limit to only refs/tags."
>               ;; Create an in-memory remote so we don't touch disk.
>               (remote (remote-create-anonymous repository url)))
>          (remote-connect remote)
> -        (remote-disconnect remote)
> -        (repository-close! repository)
> -
> -        (filter-map (lambda (remote)
> -                      (let ((name (remote-head-name remote)))
> -                        (and (include? name)
> -                             name)))
> -                    (remote-ls remote)))))))
> +
> +        (let* ((remote-heads (remote-ls remote))
> +               (refs (filter-map remote-head->ref remote-heads)))
> +          ;; Wait until we're finished with the repository before closing it.
> +          (remote-disconnect remote)
> +          (repository-close! repository)
> +          refs))))))
>  
>  \f
>  ;;;

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH v3 0/3] Add 'generic-git' updater
  2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
                     ` (2 preceding siblings ...)
  2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
@ 2021-09-17  8:04   ` Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
                       ` (3 more replies)
  3 siblings, 4 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-17  8:04 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

[-- Attachment #1: Type: text/plain, Size: 1698 bytes --]

Changes since v2:

* Address the feedback by Ludovic and Sarah.

One problem I noticed was that when ‘accept-pre-releases?’ is #t, a tag
like “1-2-3-alpha” would turn into “1.2.3.alpha”, but I think the
correct version string would be “1.2.3-alpha”.

I solved the problem by making the pre-release part a separate regexp
group, and then appending the pre-release part after extracting the
version from the tag.  That way, the “-” in “-alpha” would not be
interpreted as a version delimiter.  I also added a new test for testing
this.

One of the tests in tests/channels.scm is failing; I am not sure why.
Before the first and second patches were applied, 6 of them were failing
for me, so I guess it’s an improvement.  However, on IRC, Ludovic said
that all of them were passing (prior to apply my patches).  It would
be great if people could run the tests before and after applying
patches, and see if they pass.

Xinglu Chen (3):
  tests: git: Don't read from the users global Git config file.
  tests: git: Make 'tag' directive non-interactive.
  import: Add 'generic-git' updater.

 Makefile.am          |   2 +
 doc/guix.texi        |  34 ++++++
 guix/git.scm         |  41 ++++++++
 guix/import/git.scm  | 225 +++++++++++++++++++++++++++++++++++++++
 guix/tests/git.scm   |   6 +-
 tests/channels.scm   |   2 +-
 tests/git.scm        |  28 +++++
 tests/import-git.scm | 245 +++++++++++++++++++++++++++++++++++++++++++
 8 files changed, 580 insertions(+), 3 deletions(-)
 create mode 100644 guix/import/git.scm
 create mode 100644 tests/import-git.scm


base-commit: 33bc3fb2a5f30a6e21f1b8d6d43867d921bd951c
-- 
2.33.0




[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 861 bytes --]

^ permalink raw reply	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file.
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
@ 2021-09-17  8:04     ` Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
                       ` (2 subsequent siblings)
  3 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-17  8:04 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

* guix/tests/git (populate-git-repository): Set the GIT_CONFIG_GLOBAL
environment variable to the temporary Git config file.
---
 guix/tests/git.scm | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index b8e5f7e643..e11541e83b 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -53,6 +54,7 @@ Return DIRECTORY on success."
        (with-environment-variables
         `(("GIT_CONFIG_NOSYSTEM" "1")
           ("GIT_ATTR_NOSYSTEM" "1")
+          ("GIT_CONFIG_GLOBAL" ,(string-append home "/.gitconfig"))
           ("HOME" ,home))
         (apply invoke (git-command) "-C" directory
                command args)))))
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH v3 2/3] tests: git: Make 'tag' directive non-interactive.
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
@ 2021-09-17  8:04     ` Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater Xinglu Chen
  2021-09-18 17:47     ` bug#50359: [PATCH v3 0/3] " Ludovic Courtès
  3 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-17  8:04 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

When running 'git tag TAGNAME', Git will open up the user's default text
editor to make them write a message.  This is not desirable when running
tests.

* guix/tests/git.scm (populate-git-repository): Make the 'tag' directive take
an additional argument, and pass it to the '-m' flag.
* tests/channels.scm ("channel-news, one entry"): Adjust accordingly.
---
 guix/tests/git.scm | 4 ++--
 tests/channels.scm | 2 +-
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index e11541e83b..e8d4946e87 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -87,8 +87,8 @@ Return DIRECTORY on success."
       ((('commit text ('signer fingerprint)) rest ...)
        (git "commit" "-m" text (string-append "--gpg-sign=" fingerprint))
        (loop rest))
-      ((('tag name) rest ...)
-       (git "tag" name)
+      ((('tag name text) rest ...)
+       (git "tag" "-m" text name)
        (loop rest))
       ((('branch name) rest ...)
        (git "branch" name)
diff --git a/tests/channels.scm b/tests/channels.scm
index 0264369d9e..8f7ff1e7a8 100644
--- a/tests/channels.scm
+++ b/tests/channels.scm
@@ -329,7 +329,7 @@
         (commit "first commit")
         (add "src/a.txt" "A")
         (commit "second commit")
-        (tag "tag-for-first-news-entry")
+        (tag "tag-for-first-news-entry" "First news entry!")
         (add "news.scm"
              ,(lambda (repository)
                 (let ((previous
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater.
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
@ 2021-09-17  8:04     ` Xinglu Chen
  2021-09-18 17:47     ` bug#50359: [PATCH v3 0/3] " Ludovic Courtès
  3 siblings, 0 replies; 31+ messages in thread
From: Xinglu Chen @ 2021-09-17  8:04 UTC (permalink / raw)
  To: 50359; +Cc: Ludovic Courtès, Sarah Morgensen

* guix/git.scm (ls-remote-refs): New procedure.
* tests/git.scm ("remote-refs" "remote-refs: only tags"): New tests.
* guix/import/git.scm: New file.
* doc/guix.texi (Invoking guix refresh): Document it.
* tests/import-git.scm: New test file.
* Makefile.am (MODULES, SCM_TESTS): Register the new files.

Co-authored-by: Sarah Morgensen <iskarian@mgsn.dev>
---
 Makefile.am          |   2 +
 doc/guix.texi        |  34 ++++++
 guix/git.scm         |  41 ++++++++
 guix/import/git.scm  | 225 +++++++++++++++++++++++++++++++++++++++
 tests/git.scm        |  28 +++++
 tests/import-git.scm | 245 +++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 575 insertions(+)
 create mode 100644 guix/import/git.scm
 create mode 100644 tests/import-git.scm

diff --git a/Makefile.am b/Makefile.am
index 299bc0f7fb..f3bdc7448e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -254,6 +254,7 @@ MODULES =					\
   guix/import/egg.scm   			\
   guix/import/elpa.scm   			\
   guix/import/gem.scm				\
+  guix/import/git.scm                           \
   guix/import/github.scm   			\
   guix/import/gnome.scm				\
   guix/import/gnu.scm				\
@@ -473,6 +474,7 @@ SCM_TESTS =					\
   tests/graph.scm				\
   tests/gremlin.scm				\
   tests/hackage.scm				\
+  tests/import-git.scm				\
   tests/import-utils.scm			\
   tests/inferior.scm				\
   tests/lint.scm				\
diff --git a/doc/guix.texi b/doc/guix.texi
index 2fc9687910..6436e83a7c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11928,6 +11928,40 @@ the updater for @uref{https://launchpad.net, Launchpad} packages.
 @item generic-html
 a generic updater that crawls the HTML page where the source tarball of
 the package is hosted, when applicable.
+
+@item generic-git
+a generic updater for packages hosted on Git repositories.  It tries to
+be smart about parsing Git tag names, but if it is not able to parse the
+tag name and compare tags correctly, users can define the following
+properties for a package.
+
+@itemize
+@item @code{release-tag-prefix}: a regular expression for matching a prefix of
+the tag name.
+
+@item @code{release-tag-suffix}: a regular expression for matching a suffix of
+the tag name.
+
+@item @code{release-tag-version-delimiter}: a string used as the delimiter in
+the tag name for separating the numbers of the version.
+
+@item @code{accept-pre-releases}: by default, the updater will ignore
+pre-releases; to make it also look for pre-releases, set the this
+property to @code{#t}.
+
+@end itemize
+
+@lisp
+(package
+  (name "foo")
+  ;; ...
+  (properties
+    '((release-tag-prefix . "^release0-")
+      (release-tag-suffix . "[a-z]?$")
+      (release-tag-version-delimiter . ":"))))
+@end lisp
+
+
 @end table
 
 For instance, the following command only checks for updates of Emacs
diff --git a/guix/git.scm b/guix/git.scm
index acc48fd12f..bbff4fc890 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -57,6 +57,8 @@
             commit-difference
             commit-relation
 
+            remote-refs
+
             git-checkout
             git-checkout?
             git-checkout-url
@@ -571,6 +573,45 @@ objects: 'ancestor (meaning that OLD is an ancestor of NEW), 'descendant, or
               (if (set-contains? oldest new)
                   'descendant
                   'unrelated))))))
+\f
+;;
+;;; Remote operations.
+;;;
+
+(define* (remote-refs url #:key tags?)
+  "Return the list of references advertised at Git repository URL.  If TAGS?
+is true, limit to only refs/tags."
+  (define (ref? ref)
+    ;; Like `git ls-remote --refs', only show actual references.
+    (and (string-prefix? "refs/" ref)
+         (not (string-suffix? "^{}" ref))))
+
+  (define (tag? ref)
+    (string-prefix? "refs/tags/" ref))
+
+  (define (include? ref)
+    (and (ref? ref)
+         (or (not tags?) (tag? ref))))
+
+  (define (remote-head->ref remote)
+    (let ((name (remote-head-name remote)))
+      (and (include? name)
+           name)))
+
+  (with-libgit2
+   (call-with-temporary-directory
+    (lambda (cache-directory)
+      (let* ((repository (repository-init cache-directory))
+             ;; Create an in-memory remote so we don't touch disk.
+             (remote (remote-create-anonymous repository url)))
+        (remote-connect remote)
+
+        (let* ((remote-heads (remote-ls remote))
+               (refs (filter-map remote-head->ref remote-heads)))
+          ;; Wait until we're finished with the repository before closing it.
+          (remote-disconnect remote)
+          (repository-close! repository)
+          refs))))))
 
 \f
 ;;;
diff --git a/guix/import/git.scm b/guix/import/git.scm
new file mode 100644
index 0000000000..1eb219f3fe
--- /dev/null
+++ b/guix/import/git.scm
@@ -0,0 +1,225 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix import git)
+  #:use-module (guix build utils)
+  #:use-module (guix diagnostics)
+  #:use-module (guix git)
+  #:use-module (guix git-download)
+  #:use-module (guix i18n)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module (guix utils)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:export (%generic-git-updater
+
+            ;; For tests.
+            latest-git-tag-version))
+
+;;; Commentary:
+;;;
+;;; This module provides a generic package updater for packages hosted on Git
+;;; repositories.
+;;;
+;;; It tries to be smart about tag names, but if it is not automatically able
+;;; to parse the tag names correctly, users can set the `release-tag-prefix',
+;;; `release-tag-suffix' and `release-tag-version-delimiter' properties of the
+;;; package to make the updater parse the Git tag name correctly.
+;;;
+;;; Possible improvements:
+;;;
+;;; * More robust method for trying to guess the delimiter.  Maybe look at the
+;;;   previous version/tag combo to determine the delimiter.
+;;;
+;;; * Differentiate between "normal" versions, e.g., 1.2.3, and dates, e.g.,
+;;;   2021.12.31.  Honor a `release-tag-date-scheme?' property?
+;;;
+;;; Code:
+
+;;; Errors & warnings
+
+(define-condition-type &git-no-valid-tags-error &error
+  git-no-valid-tags-error?)
+
+(define (git-no-valid-tags-error)
+  (raise (condition (&message (message "no valid tags found"))
+                    (&git-no-valid-tags-error))))
+
+(define-condition-type &git-no-tags-error &error
+  git-no-tags-error?)
+
+(define (git-no-tags-error)
+  (raise (condition (&message (message "no tags were found"))
+                    (&git-no-tags-error))))
+
+\f
+;;; Updater
+
+(define %pre-release-words
+  '("alpha" "beta" "rc" "dev" "test" "pre"))
+
+(define %pre-release-rx
+  (map (lambda (word)
+         (make-regexp (string-append ".+" word) regexp/icase))
+       %pre-release-words))
+
+(define* (version-mapping tags #:key prefix suffix delim pre-releases?)
+  "Given a list of Git TAGS, return an association list where the car is the
+version corresponding to the tag, and the cdr is the name of the tag."
+  (define (guess-delimiter)
+    (let ((total (length tags))
+          (dots (reduce + 0 (map (cut string-count <> #\.) tags)))
+          (dashes (reduce + 0 (map (cut string-count <> #\-) tags)))
+          (underscores (reduce + 0 (map (cut string-count <> #\_) tags))))
+      (cond
+       ((>= dots (* total 0.35)) ".")
+       ((>= dashes (* total 0.8)) "-")
+       ((>= underscores (* total 0.8)) "_")
+       (else ""))))
+
+  (define delim-rx (regexp-quote (or delim (guess-delimiter))))
+  (define suffix-rx  (string-append (or suffix "") "$"))
+  (define prefix-rx (string-append "^" (or prefix "[^[:digit:]]*")))
+  (define pre-release-rx
+    (if pre-releases?
+        (string-append "(.*(" (string-join %pre-release-words "|") ").*)")
+        ""))
+
+  (define tag-rx
+    (string-append prefix-rx "([[:digit:]][^" delim-rx "[:punct:]]*"
+                   "(" delim-rx "[^[:punct:]" delim-rx "]+)"
+                   ;; If there are no delimiters, it could mean that the
+                   ;; version just contains one number (e.g., "2"), thus, use
+                   ;; "*" instead of "+" to match zero or more numbers.
+                   (if (string=? delim-rx "") "*" "+") ")"
+                   ;; We don't want the pre-release stuff (e.g., "-alpha") be
+                   ;; part of the first group; otherwise, the "-" in "-alpha"
+                   ;; might be interpreted as a delimiter, and thus replaced
+                   ;; with "."
+                   pre-release-rx suffix-rx))
+
+
+
+  (define (get-version tag)
+    (let ((tag-match (regexp-exec (make-regexp tag-rx) tag)))
+      (and=> (and tag-match
+                  (regexp-substitute/global
+                   #f delim-rx (match:substring tag-match 1)
+                   ;; If there were no delimiters, don't insert ".".
+                   'pre (if (string=? delim-rx "") "" ".") 'post))
+             (lambda (version)
+               (if pre-releases?
+                   (string-append version (match:substring tag-match 3))
+                   version)))))
+
+  (define (entry<? a b)
+    (eq? (version-compare (car a) (car b)) '<))
+
+  (stable-sort (filter-map (lambda (tag)
+                             (let ((version (get-version tag)))
+                               (and version (cons version tag))))
+                           tags)
+               entry<?))
+
+(define* (latest-tag url #:key prefix suffix delim pre-releases?)
+  "Return the latest version and corresponding tag available from the Git
+repository at URL."
+  (define (pre-release? tag)
+    (any (cut regexp-exec <> tag)
+         %pre-release-rx))
+
+  (let* ((tags (map (cut string-drop <> (string-length "refs/tags/"))
+                    (remote-refs url #:tags? #t)))
+         (versions->tags
+          (version-mapping (if pre-releases?
+                               tags
+                               (filter (negate pre-release?) tags))
+                           #:prefix prefix
+                           #:suffix suffix
+                           #:delim delim
+                           #:pre-releases? pre-releases?)))
+    (cond
+     ((null? tags)
+      (git-no-tags-error))
+     ((null? versions->tags)
+      (git-no-valid-tags-error))
+     (else
+      (match (last versions->tags)
+        ((version . tag)
+         (values version tag)))))))
+
+(define (latest-git-tag-version package)
+  "Given a PACKAGE, return the latest version of it, or #f if the latest version
+could not be determined."
+  (guard (c ((or (git-no-tags-error? c) (git-no-valid-tags-error? c))
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "~a for ~a~%")
+                      (condition-message c)
+                      (package-name package))
+             #f)
+            ((eq? (exception-kind c) 'git-error)
+             (warning (or (package-field-location package 'source)
+                          (package-location package))
+                      (G_ "failed to fetch Git repository for ~a~%")
+                      (package-name package))
+             #f))
+    (let* ((source (package-source package))
+           (url (git-reference-url (origin-uri source)))
+           (property (cute assq-ref (package-properties package) <>)))
+      (latest-tag url
+                  #:prefix (property 'release-tag-prefix)
+                  #:suffix (property 'release-tag-suffix)
+                  #:delim (property 'release-tag-version-delimiter)
+                  #:pre-releases? (property 'accept-pre-releases?)))))
+
+(define (git-package? package)
+  "Return true if PACKAGE is hosted on a Git repository."
+  (match (package-source package)
+    ((? origin? origin)
+     (and (eq? (origin-method origin) git-fetch)
+          (git-reference? (origin-uri origin))))
+    (_ #f)))
+
+(define (latest-git-release package)
+  "Return an <upstream-source> for the latest release of PACKAGE."
+  (let* ((name (package-name package))
+         (old-version (package-version package))
+         (url (git-reference-url (origin-uri (package-source package))))
+         (new-version (latest-git-tag-version package)))
+
+    (and new-version
+         (upstream-source
+          (package name)
+          (version new-version)
+          (urls (list url))))))
+
+(define %generic-git-updater
+  (upstream-updater
+   (name 'generic-git)
+   (description "Updater for packages hosted on Git repositories")
+   (pred git-package?)
+   (latest latest-git-release)))
diff --git a/tests/git.scm b/tests/git.scm
index aa4f03ca62..d0646bbc85 100644
--- a/tests/git.scm
+++ b/tests/git.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -161,4 +162,31 @@
               (commit-relation master1 merge)
               (commit-relation merge master1))))))
 
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs"
+  '("refs/heads/develop" "refs/heads/master"
+    "refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "release-1.0")
+        (branch "develop")
+        (checkout "develop")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "release-1.1"))
+    (remote-refs directory)))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "remote-refs: only tags"
+ '("refs/tags/v1.0" "refs/tags/v1.1")
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "v1.0" "Release 1.0")
+        (add "b.txt" "B")
+        (commit "Second commit")
+        (tag "v1.1" "Release 1.1"))
+    (remote-refs directory #:tags? #t)))
+
 (test-end "git")
diff --git a/tests/import-git.scm b/tests/import-git.scm
new file mode 100644
index 0000000000..f1bce154bb
--- /dev/null
+++ b/tests/import-git.scm
@@ -0,0 +1,245 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (test-import-git)
+  #:use-module (git)
+  #:use-module (guix git)
+  #:use-module (guix tests)
+  #:use-module (guix packages)
+  #:use-module (guix import git)
+  #:use-module (guix git-download)
+  #:use-module (guix tests git)
+  #:use-module (guix build utils)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64))
+
+;; Test the (guix import git) tools.
+
+(test-begin "git")
+
+(define* (make-package directory version #:optional (properties '()))
+  (dummy-package "test-package"
+    (version version)
+    (properties properties)
+    (source
+     (origin
+       (method git-fetch)
+       (uri (git-reference
+             (url (string-append "file://" directory))
+             (commit version)))
+       (sha256
+        (base32
+         "0000000000000000000000000000000000000000000000000000"))))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, no suffix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix-1.0.1" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "prefix-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom suffix, no prefix and delimiter"
+  "1.0.1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "1.0.1-suffix-123" "Release 1.0.1"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-suffix . "-suffix-[0-9]*")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom delimiter, no prefix and suffix"
+  "2021.09.07"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2021-09-07" "Release 2021-09-07"))
+    (let ((package (make-package directory "2021-09-06"
+                                 '((release-tag-version-delimiter . "-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: empty delimiter, no prefix and suffix"
+  "20210907"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "20210907" "Release 20210907"))
+    (let ((package (make-package directory "20210906"
+                                 '((release-tag-version-delimiter . "")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix and suffix, no delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2.0.0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: custom prefix, suffix, and delimiter"
+  "2.0.0"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Release-2_0_0suffix-1" "Release 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((release-tag-prefix . "Release-")
+                                   (release-tag-suffix . "suffix-[0-9]")
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: only pre-releases available"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom prefix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "version-2.0.0-rc1" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "version-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix"
+  "2.0.0-rc1"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2.0.0-rc1-suffix" "Release candidate for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, delimiter conflicts with pre-release part"
+  "2.0.0_alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "2_0_0_alpha" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-version-delimiter . "_")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix and prefix"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2.0.0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, and custom suffix, prefix, and delimiter"
+  "2.0.0-alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2-0-0-alpha-suffix" "Alpha release for 2.0.0"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")
+                                   (release-tag-version-delimiter . "-")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: accept pre-releases, no delimiter, and custom suffix, prefix"
+  "2alpha"
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "prefix123-2alpha-suffix" "Alpha release for version 2"))
+    (let ((package (make-package directory "1.0.0"
+                                 '((accept-pre-releases? . #t)
+                                   (release-tag-prefix . "prefix[0-9]{3}-")
+                                   (release-tag-suffix . "-suffix")
+                                   (release-tag-version-delimiter . "")))))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(unless (which (git-command)) (test-skip 1))
+(test-equal "latest-git-tag-version: no valid tags found"
+  #f
+  (with-temporary-git-repository directory
+      '((add "a.txt" "A")
+        (commit "First commit")
+        (tag "Test" "Test tag"))
+    (let ((package (make-package directory "1.0.0")))
+      (latest-git-tag-version package))))
+
+(test-end "git")
-- 
2.33.0







^ permalink raw reply related	[flat|nested] 31+ messages in thread

* bug#50359: [PATCH v3 0/3] Add 'generic-git' updater
  2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
                       ` (2 preceding siblings ...)
  2021-09-17  8:04     ` [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater Xinglu Chen
@ 2021-09-18 17:47     ` Ludovic Courtès
  3 siblings, 0 replies; 31+ messages in thread
From: Ludovic Courtès @ 2021-09-18 17:47 UTC (permalink / raw)
  To: Xinglu Chen; +Cc: Sarah Morgensen, 50359-done

Hello!

Xinglu Chen <public@yoctocell.xyz> skribis:

> Changes since v2:
>
> * Address the feedback by Ludovic and Sarah.
>
> One problem I noticed was that when ‘accept-pre-releases?’ is #t, a tag
> like “1-2-3-alpha” would turn into “1.2.3.alpha”, but I think the
> correct version string would be “1.2.3-alpha”.
>
> I solved the problem by making the pre-release part a separate regexp
> group, and then appending the pre-release part after extracting the
> version from the tag.  That way, the “-” in “-alpha” would not be
> interpreted as a version delimiter.  I also added a new test for testing
> this.

I think that’s fine; this is all guesswork anyway, and there are always
cases where we’ll get it wrong.  What’s useful though is tests to guard
against regressions in the heuristics.

> One of the tests in tests/channels.scm is failing; I am not sure why.
> Before the first and second patches were applied, 6 of them were failing
> for me, so I guess it’s an improvement.  However, on IRC, Ludovic said
> that all of them were passing (prior to apply my patches).  It would
> be great if people could run the tests before and after applying
> patches, and see if they pass.

Turns out that the failure in tests/channels.scm was a real bug:
‘channel-news-entry-commit’ was not resolving annotated tags correctly
(it would return the ID of the tag instead of the ID of the commit
pointed to by the tag).  Fixed in
778c1fb4eabbb48c05f6c7555c89466d5249ebce.

>   tests: git: Don't read from the users global Git config file.
>   tests: git: Make 'tag' directive non-interactive.
>   import: Add 'generic-git' updater.

Applied!  I changed the second patch to preserve support for
non-annotated tags and to leave tests/channels.scm unchanged.

BTW, “git tag xyz” is not interactive AFAICS.

Thanks Sarah & Xinglu for this work!  Let’s update our packages!  :-)

Ludo’.




^ permalink raw reply	[flat|nested] 31+ messages in thread

end of thread, other threads:[~2021-09-18 17:48 UTC | newest]

Thread overview: 31+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-09-03 15:50 [bug#50359] [PATCH] import: Add 'generic-git' updater Xinglu Chen
2021-09-05  0:19 ` Sarah Morgensen
2021-09-05  1:03   ` Sarah Morgensen
2021-09-05 10:36   ` Xinglu Chen
2021-09-06  5:40     ` Sarah Morgensen
2021-09-06 12:20       ` Xinglu Chen
2021-09-07  1:00         ` Sarah Morgensen
2021-09-07 19:13           ` Xinglu Chen
2021-09-08 18:28             ` Xinglu Chen
2021-09-10  8:36               ` Ludovic Courtès
2021-09-10 13:23                 ` Xinglu Chen
2021-09-05 13:11   ` Xinglu Chen
2021-09-06  3:14     ` Sarah Morgensen
2021-09-10 16:20 ` [bug#50359] [PATCH 0/3] " Xinglu Chen
2021-09-10 16:21   ` [bug#50359] [PATCH 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
2021-09-10 16:21   ` [bug#50359] [PATCH 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
2021-09-13  8:03     ` Ludovic Courtès
2021-09-10 16:21   ` [bug#50359] [PATCH 3/3] import: Add 'generic-git' updater Xinglu Chen
2021-09-13  8:07     ` Ludovic Courtès
2021-09-16  9:09     ` Sarah Morgensen
2021-09-16 12:48       ` Xinglu Chen
2021-09-16 23:42         ` Sarah Morgensen
2021-09-17  7:48           ` Xinglu Chen
2021-09-17  8:04   ` [bug#50359] [PATCH v3 0/3] " Xinglu Chen
2021-09-17  8:04     ` [bug#50359] [PATCH v3 1/3] tests: git: Don't read from the users global Git config file Xinglu Chen
2021-09-17  8:04     ` [bug#50359] [PATCH v3 2/3] tests: git: Make 'tag' directive non-interactive Xinglu Chen
2021-09-17  8:04     ` [bug#50359] [PATCH v3 3/3] import: Add 'generic-git' updater Xinglu Chen
2021-09-18 17:47     ` bug#50359: [PATCH v3 0/3] " Ludovic Courtès
2021-09-15  8:44 ` [bug#50359] [PATCH 3/3] import: " iskarian
2021-09-15 11:59   ` Xinglu Chen
2021-09-16  9:46     ` Sarah Morgensen

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).