refresh: Add support for partial target versions.

* guix/import/utils.scm (find-version): New procedure.
* guix/scripts/refresh.scm (<update-spec>) [partial?]: New field.
(update-spec-partial?): New accessor.
(update-spec): Add a PARTIAL? optional argument.
(update-specification->update-spec) <update-spec>: Call with its new PARTIAL?
optional argument when FALLBACK-VERSION is provided, i.e. when
'--target-version' was used.
(update-package): Remove the PACKAGE and VERSION positional arguments, and
replace them with UPDATE-SPEC.  Update doc.  Call `package-update' with its
new #:partial-version? argument.
(check-for-package-update) <package-latest-release>: Pass the new
 #:partial-version? argument to it.
(guix-refresh) <update-package>: Adjust call accordingly.
(show-help): Udate doc.
* guix/upstream.scm (package-latest-release): Add #:partial-version? argument,
and apply it to the importer call.
(package-update): Add #:partial-version?> argument.  Update doc.  Pass it to
the `package-latest-release' call.
* guix/gnu-maintenance.scm (rewrite-url): Add #:partial-version? argument.
Update doc.  Crawl URL for newer compatible versions when provided.
(import-html-release): Add #:partial-version? argument, and pass it to the
`rewrite-url' call.  Use `find-version' to find the best version.
(import-release, import-ftp-release, import-gnu-release)
(import-release*): Add #:partial-version? argument and honor it.
(import-html-updatable-release): Add #:partial-version? argument, and pass it
to the `import-html-release' call.
* guix/import/gnome.scm (import-gnome-release)
<#:partial-version?>: Add new argument and honor it.
* guix/import/texlive.scm (latest-texlive-tag): Rename to...
(texlive-tags): ... this, and have it return all tags.
(texlive->guix-package): Adjust accordingly.
(latest-release): Add a #:partial-version? argument.  Update doc.
* guix/import/stackage.scm (latest-lts-release): New #:partial-version?
argument.
* guix/import/pypi.scm (import-release): New #:partial-version? argument; pass
it to `pypi-package->upstream-source'.
* guix/import/opam.scm (latest-release): New #:partial-version? argument.
* guix/import/minetest.scm (latest-minetest-release): New #:partial-version?
argument.
(pypi-package->upstream-source): New #:partial-version? argument.  Update doc.
* guix/import/launchpad.scm (latest-released-version): Rename to...
(release-versions): ... this, making it return all versions.
(import-release) <#:partial-version?>: New argument.
* guix/import/kde.scm (import-kde-release)
<#:partial-version?>: New argument.  Update doc.  Refactor to honor argument.
* guix/import/hexpm.scm (lookup-hexpm): Update doc.
(hexpm-latest-release): Rename to...
(hexpm-releases): ... this; return all release strings.
(hexpm->guix-package): Adjust accordingly.
(import-release): Add and honor a #:partial-version? argument.  Update doc.
* guix/import/hackage.scm (import-release): New #:partial-version? argument.
* guix/import/cpan.scm (latest-release): New #:partial-version? argument.
* guix/import/crate.scm (max-crate-version-of-semver): Improve doc.
(import-release): Add a #:partial-version? argument and honor it.
* guix/import/egg.scm (find-latest-version): Rename to...
(get-versions): ... this, returning all versions.
(egg-metadata): Adjust accordingly.
(egg->guix-package): Likewise.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/elpa.scm (latest-release):  New #:partial-version? argument.
* guix/import/gem.scm (get-versions): New procedure.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/git.scm (version-mapping): Update doc; streamline a bit.
(latest-tag): Rename to...
(get-tags): ... this, dropping the #:version keyword and returning the complete
tags alist.  Update doc.
(latest-git-tag-version): Rename to...
(get-package-tags): ... this, returning the complete tags alist of the
package.  Update doc.
(import-git-release): Add a new #:partial-version? argument and honor it.
Update doc.
* guix/import/github.scm (latest-released-version): Rename to...
(get-package-tags): ... this, returning all tags.  Update doc.
(import-release): Add a new #:partial-version? argument and honor it.
* guix/import/cran.scm (latest-cran-release)
(latest-bioconductor-release): Add #:partial-version? argument.
* guix/import/composer.scm (latest-version): Delete procedure.
(composer-fetch): Add #:partial-version? keyword and honor it.  Update doc.
(import-release): Likewise.
* guix/import/test.scm (import-release): Add #:partial-version? argument.
* tests/guix-refresh.sh: Add test.
* tests/gem.scm (test-foo-versions-json): New variable.
(package-latest-release): Mock new URL.
* tests/import-git.scm (latest-git-tag-version): New procedure.
* tests/gnu-maintenance.scm (libuv-dist-html)
(libuv-dist-1.46.0-html, libuv-dist-1.44.2-html)
(libuv-html-data): New variables.
(mock-http-fetch/cached): New procedure.
("rewrite-url, without to-version"): Rewrite using the above.
("rewrite-url, partial to-version"): New test.
* doc/guix.texi <"Invoking guix refresh">: Update doc.

Series-to: 75871@debbugs.gnu.org
Change-Id: I092a58b57ac42e54a2fa55e7761e8c6993af8ad4

4 files changed, 89 insertions, 12 deletions

diff --git a/tests/gem.scm b/tests/gem.scm
index dae29437e5..beee150875 100644
--- a/tests/gem.scm
+++ b/tests/gem.scm
@@ -49,6 +49,25 @@
   \"licenses\": [\"MIT\", \"Apache 2.0\"]
 }")
 
+(define test-foo-versions-json
+  "[{\"authors\": \" Maxim \",
+     \"built_at\": \"2012-10-24T00:00:00.000Z\",
+     \"created_at\": \"2012-11-03T07:41:49.007Z\",
+     \"description\": \"test gem\",
+     \"downloads_count\" :9195,
+     \"metadata\": {\"homepage_uri\":\"\"},
+     \"number\": \"1.0.0\",
+     \"summary\": \"foo!!!\",
+     \"platform\": \"ruby\",
+     \"rubygems_version\": \"\u003e= 0\",
+     \"ruby_version\": null,
+     \"priceless\": false,
+     \"licenses\": null,
+     \"requirements\": null,
+     \"sha\": \"523009a5b977f79c8eaa79b521e416f26482bc4fbbcc04bd08580696e303a715\",
+     \"spec_sha\": \"c7cf42bac0d01eb12b68294d1cdb4e20e7cb222ca958ad70ed1e9a686b551819\"
+}]")
+
 (define test-foo-v2-json
   "{
   \"name\": \"foo\",
@@ -273,6 +292,9 @@
              ("https://rubygems.org/api/v1/gems/foo.json"
               (values (open-input-string test-foo-json)
                       (string-length test-foo-json)))
+             ("https://rubygems.org/api/v1/versions/foo.json"
+              (values (open-input-string test-foo-versions-json)
+                      (string-length test-foo-versions-json)))
              (_ (error "Unexpected URL: " url)))))
         (let ((source (package-latest-release
                        (dummy-package "ruby-foo"
diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm
index 6fde1eb8b1..82a02bec6f 100644
--- a/tests/gnu-maintenance.scm
+++ b/tests/gnu-maintenance.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2023-2024 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +27,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-64)
   #:use-module ((web client) #:select (current-http-proxy))
+  #:use-module ((web uri) #:select (uri? uri->string))
   #:use-module (ice-9 match))
 
 (test-begin "gnu-maintenance")
@@ -157,11 +159,17 @@ submodules/qtbase-everywhere-src-6.5.2.tar.xz"
   (rewrite-url "https://download.qt.io/official_releases/qt/6.3/6.3.2/\
 submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
 
-(test-equal "rewrite-url, without to-version"
-  "http://dist.libuv.example.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
-  (with-http-server
-      ;; First reply, crawling http://dist.libuv.example.org/dist/.
-      `((200 "\
+(define (mock-http-fetch/cached testcase)
+  (lambda (url . rest)
+    (let* ((url (if (uri? url)
+                    (uri->string url)
+                    url))
+           (body (assoc-ref testcase url)))
+      (if body
+          (open-input-string body)
+          (error "mocked http-fetch Unexpected URL: " url)))))
+
+(define libuv-dist-html "\
 <!DOCTYPE html>
 <html>
 <head><title>Index of dist</title></head>
@@ -174,8 +182,8 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
 <a href=\"v1.46.0/\" title=\"v1.46.0/\">v1.46.0/</a>
 </body>
 </html>")
-        ;; Second reply, crawling http://dist.libuv.example.org/dist/v1.46.0/.
-        (200 "\
+
+(define libuv-dist-1.46.0-html "\
 <!DOCTYPE html>
 <html>
 <head><title>Index of dist/v1.46.0</title></head>
@@ -190,9 +198,44 @@ submodules/qtbase-everywhere-src-6.3.2.tar.xz" "6.3.2" #:to-version "6.5.2"))
 <a href=\"libuv-v1.46.0.tar.gz.sign\" title=\"libuv-v1.46.0.tar.gz.sign\">
    libuv-v1.46.0.tar.gz.sign</a>
 </body>
-</html>"))
-    (parameterize ((current-http-proxy (%local-url)))
-      (rewrite-url "http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
-                   "1.45.0"))))
+</html>")
+
+(define libuv-dist-1.44.2-html "\
+<!DOCTYPE html>
+<html>
+<head><title>Index of dist/v1.44.2</title></head>
+<body>
+<a href=\"../\">../</a>
+<a href=\"libuv-v1.44.2-dist.tar.gz\" title=\"libuv-v1.44.2-dist.tar.gz\">
+   libuv-v1.44.2-dist.tar.gz</a>
+<a href=\"libuv-v1.44.2-dist.tar.gz.sign\" title=\"libuv-v1.44.2-dist.tar.gz.sign\">
+   libuv-v1.44.2-dist.tar.gz.sign</a>
+<a href=\"libuv-v1.44.2.tar.gz\" title=\"libuv-v1.44.2.tar.gz\">
+   libuv-v1.44.2.tar.gz</a>
+<a href=\"libuv-v1.44.2.tar.gz.sign\" title=\"libuv-v1.44.2.tar.gz.sign\">
+   libuv-v1.44.2.tar.gz.sign</a>
+</body>
+</html>")
+
+(define libuv-html-data
+  `(("http://dist.libuv.example.org/dist" . ,libuv-dist-html)
+    ("http://dist.libuv.example.org/dist/v1.44.2" . ,libuv-dist-1.44.2-html)
+    ("http://dist.libuv.example.org/dist/v1.46.0" . ,libuv-dist-1.46.0-html)))
+
+(test-equal "rewrite-url, without to-version"
+  "http://dist.libuv.example.org/dist/v1.46.0/libuv-v1.46.0.tar.gz"
+  (mock ((guix http-client) http-fetch/cached
+         (mock-http-fetch/cached libuv-html-data))
+        (rewrite-url
+         "http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
+         "1.45.0")))
+
+(test-equal "rewrite-url, partial to-version"
+  "http://dist.libuv.example.org/dist/v1.44.2/libuv-v1.44.2.tar.gz"
+  (mock ((guix http-client) http-fetch/cached
+         (mock-http-fetch/cached libuv-html-data))
+        (rewrite-url
+         "http://dist.libuv.example.org/dist/v1.45.0/libuv-v1.45.0.tar.gz"
+         "1.45.0" #:to-version "1.44" #:partial-version? #t)))
 
 (test-end)
diff --git a/tests/guix-refresh.sh b/tests/guix-refresh.sh
index 2ce3c592ab..b5b38189cb 100644
--- a/tests/guix-refresh.sh
+++ b/tests/guix-refresh.sh
@@ -31,7 +31,8 @@ export GUIX_TEST_UPDATER_TARGETS
 idutils_version="$(guix package -A ^idutils$ | cut -f2)"
 GUIX_TEST_UPDATER_TARGETS='
   (("guile" "3" (("12.5" "file:///dev/null")
-                 ("1.6.4" "file:///dev/null")))
+                 ("1.6.4" "file:///dev/null")
+                 ("3.13.3" "file:///dev/null")))
    ("libreoffice" "" (("1.0" "file:///dev/null")))
    ("idutils" "" (("'$idutils_version'" "file:///dev/null")))
    ("the-test-package" "" (("5.5" "file://'$PWD/$module_dir'/source"
@@ -116,6 +117,13 @@ case "$(guix refresh -t test guile --target-version=2.0.0 2>&1)" in
     *) false;;
 esac
 
+# Partial target version => select the newest release prefixed by it.
+guix refresh -t test guile --target-version=3 # XXX: should return non-zero?
+case "$(guix refresh -t test guile --target-version=3 2>&1)" in
+    *"would be upgraded"*"3.13.3"*) true;;
+    *) false;;
+esac
+
 for spec in "guile=1.6.4" "guile@3=1.6.4"
 do
     guix refresh -t test "$spec"
diff --git a/tests/import-git.scm b/tests/import-git.scm
index 6dd8ad1649..a532070a8d 100644
--- a/tests/import-git.scm
+++ b/tests/import-git.scm
@@ -22,6 +22,7 @@
   #:use-module (guix tests)
   #:use-module (guix packages)
   #:use-module (guix import git)
+  #:use-module ((guix import utils) #:select (find-version))
   #:use-module (guix git-download)
   #:use-module (guix tests git)
   #:use-module (srfi srfi-1)
@@ -45,6 +46,9 @@
         (base32
          "0000000000000000000000000000000000000000000000000000"))))))
 
+(define (latest-git-tag-version package)
+  (find-version (map car ((@@ (guix import git) get-package-tags) package))))
+
 (test-equal "latest-git-tag-version: no custom prefix, suffix, and delimiter"
   "1.0.1"
   (with-temporary-git-repository directory