import/minetest: Define an updater for mods on ContentDB.

Only detecting updates is currently supported.  To actually
perform the uppdates, a patch like
<https://issues.guix.gnu.org/50072#4> is required.

* guix/import/minetest.scm
  (version-style,minetest-package?,latest-minetest-release): New procedures.
  (%minetest-updater): New updater.
* tests/minetest.scm
  (upstream-source->sexp,expected-sexp,example-package): New procedure.
  (test-release,test-no-release): New macro's.
  ("same version","new version (dotted)","new version (date)")
  ("new version (git -> dotted)","dotted->date","date->dotted")
  ("no commit informaton, no new release")
  ("minetest is not a minetest mod")
  ("technic is a minetest mod")
  ("upstream-name is required"): New tests.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

2 files changed, 172 insertions, 1 deletions

diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index ba86c60bfd..0f3ab473ca 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -25,6 +25,8 @@
   #:use-module (srfi srfi-2)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
+  #:use-module ((guix packages) #:prefix package:)
+  #:use-module (guix upstream)
   #:use-module (guix utils)
   #:use-module (guix ui)
   #:use-module (guix i18n)
@@ -36,15 +38,19 @@
   #:use-module (json)
   #:use-module (guix base32)
   #:use-module (guix git)
+  #:use-module ((guix git-download) #:prefix download:)
   #:use-module (guix store)
   #:export (%default-sort-key
             %contentdb-api
             json->package
             contentdb-fetch
             elaborate-contentdb-name
+            minetest-package?
+            latest-minetest-release
             minetest->guix-package
             minetest-recursive-import
-            sort-packages))
+            sort-packages
+            %minetest-updater))
 
 ;; The ContentDB API is documented at
 ;; <https://content.minetest.net>.
@@ -345,6 +351,17 @@ official Minetest forum and the Git repository (if any)."
       (substring title 1)
       title))
 
+(define (version-style version)
+  "Determine the kind of version number VERSION is -- a date, or a conventional
+conventional version number."
+  (define dots? (->bool (string-index version #\.)))
+  (define hyphens? (->bool (string-index version #\-)))
+  (match (cons dots? hyphens?)
+    ((#true . #false) 'regular) ; something like "0.1"
+    ((#false . #false) 'regular) ; single component version number
+    ((#true . #true) 'regular) ; result of 'git-version'
+    ((#false . #true) 'date))) ; something like "2021-01-25"
+
 ;; If the default sort key is changed, make sure to modify 'show-help'
 ;; in (guix scripts import minetest) appropriately as well.
 (define %default-sort-key "score")
@@ -466,3 +483,37 @@ list of AUTHOR/NAME strings."
   (recursive-import author/name
                     #:repo->guix-package minetest->guix-package*
                     #:guix-name contentdb->package-name))
+
+(define (minetest-package? pkg)
+  "Is PKG a Minetest mod on ContentDB?"
+  (and (string-prefix? "minetest-" (package:package-name pkg))
+       (assq-ref (package:package-properties pkg) 'upstream-name)))
+
+(define (latest-minetest-release pkg)
+  "Return an <upstream-source> for the latest release of the package PKG,
+or #false if the latest release couldn't be determined."
+  (define author/name
+    (assq-ref (package:package-properties pkg) 'upstream-name))
+  (define contentdb-package (contentdb-fetch author/name)) ; TODO warn if #f?
+  (define release (latest-release author/name))
+  (define source (package:package-source pkg))
+  (and contentdb-package release
+       (release-commit release) ; not always set
+       ;; Only continue if both the old and new version number are both
+       ;; dates or regular version numbers, as two different styles confuses
+       ;; the logic for determining which version is newer.
+       (eq? (version-style (release-version release))
+            (version-style (package:package-version pkg)))
+       (upstream-source
+        (package (package:package-name pkg))
+        (version (release-version release))
+        (urls (list (download:git-reference
+                     (url (package-repository contentdb-package))
+                     (commit (release-commit release))))))))
+
+(define %minetest-updater
+  (upstream-updater
+    (name 'minetest)
+    (description "Updater for Minetest packages on ContentDB")
+    (pred minetest-package?)
+    (latest latest-minetest-release)))
diff --git a/tests/minetest.scm b/tests/minetest.scm
index abb26d0a03..77b9aa928f 100644
--- a/tests/minetest.scm
+++ b/tests/minetest.scm
@@ -17,10 +17,18 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (test-minetest)
+  #:use-module (guix build-system minetest)
+  #:use-module (guix upstream)
   #:use-module (guix memoization)
   #:use-module (guix import minetest)
   #:use-module (guix import utils)
   #:use-module (guix tests)
+  #:use-module (guix packages)
+  #:use-module (guix git-download)
+  #:use-module ((gnu packages minetest)
+                #:select (minetest minetest-technic))
+  #:use-module ((gnu packages base)
+                #:select (hello))
   #:use-module (json)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
@@ -375,8 +383,120 @@ during a dynamic extent where that package is available on ContentDB."
     (list z y x)
     (sort-packages (list x y z))))
 
+
+
+;; Update detection
+(define (upstream-source->sexp upstream-source)
+  (define urls (upstream-source-urls upstream-source))
+  (unless (= 1 (length urls))
+    (error "only a single URL is expected"))
+  (define url (first urls))
+  `(,(upstream-source-package upstream-source)
+    ,(upstream-source-version upstream-source)
+    ,(git-reference-url url)
+    ,(git-reference-commit url)))
+
+(define* (expected-sexp #:key
+                        (repo "https://example.org/foo.git")
+                        (guix-name "minetest-foo")
+                        (new-version "0.8")
+                        (commit "44941798d222901b8f381b3210957d880b90a2fc")
+                        #:allow-other-keys)
+  `(,guix-name ,new-version ,repo ,commit))
+
+(define* (example-package #:key
+                          (source 'auto)
+                          (repo "https://example.org/foo.git")
+                          (old-version "0.8")
+                          (commit "44941798d222901b8f381b3210957d880b90a2fc")
+                          #:allow-other-keys)
+  (package
+    (name "minetest-foo")
+    (version old-version)
+    (source
+     (if (eq? source 'auto)
+         (origin
+           (method git-fetch)
+           (uri (git-reference
+                 (url repo)
+                 (commit commit #;"808f9ffbd3106da4c92d2367b118b98196c9e81e")))
+           (sha256 #f) ; not important for the following tests
+           (file-name (git-file-name name version)))
+         source))
+    (build-system minetest-mod-build-system)
+    (license #f)
+    (synopsis #f)
+    (description #f)
+    (home-page #f)
+    (properties '((upstream-name . "Author/foo")))))
+
+(define-syntax-rule (test-release test-case . arguments)
+  (test-equal test-case
+    (expected-sexp . arguments)
+    (and=>
+     (call-with-packages
+      (cut latest-minetest-release (example-package . arguments))
+      (list . arguments))
+     upstream-source->sexp)))
+
+(define-syntax-rule (test-no-release test-case . arguments)
+  (test-equal test-case
+    #f
+    (call-with-packages
+     (cut latest-minetest-release (example-package . arguments))
+     (list . arguments))))
+
+(test-release "same version"
+  #:old-version "0.8" #:title "0.8" #:new-version "0.8"
+  #:commit "44941798d222901b8f381b3210957d880b90a2fc")
+
+(test-release "new version (dotted)"
+  #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+  #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (date)"
+  #:old-version "2014-11-17" #:title "2015-11-04"
+  #:new-version "2015-11-04"
+  #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-release "new version (git -> dotted)"
+  #:old-version
+  (git-version "0.8" "1" "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+  #:title "0.9.0" #:new-version "0.9.0"
+  #:commit "90422555f114d3af35e7cc4b5b6d59a5c226adc4")
+
+;; There might actually be a new release, but guix cannot compare dates
+;; with regular version numbers.
+(test-no-release "dotted -> date"
+  #:old-version "0.8" #:title "2015-11-04"
+  #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+(test-no-release "date -> dotted"
+  #:old-version "2014-11-07" #:title "0.8"
+  #:commit "c8855b991880897b2658dc90164e29c96e2aeb3a")
+
+;; Don't let "guix refresh -t minetest" tell there are new versions
+;; if Guix has insufficient information to actually perform the update,
+;; when using --with-latest or "guix refresh -u".
+(test-no-release "no commit information, no new release"
+  #:old-version "0.8" #:title "0.9.0" #:new-version "0.9.0"
+  #:commit #false)
+
+(test-assert "minetest is not a minetest mod"
+  (not (minetest-package? minetest)))
+(test-assert "GNU hello is not a minetest mod"
+  (not (minetest-package? hello)))
+(test-assert "technic is a minetest mod"
+  (minetest-package? minetest-technic))
+(test-assert "upstream-name is required"
+  (not (minetest-package?
+        (package (inherit minetest-technic)
+                 (properties '())))))
+
 (test-end "minetest")
 
 ;;; Local Variables:
 ;;; eval: (put 'test-package* 'scheme-indent-function 1)
+;;; eval: (put 'test-release 'scheme-indent-function 1)
+;;; eval: (put 'test-no-release 'scheme-indent-function 1)
 ;;; End: