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>
This commit is contained in:
Maxime Devos
Ludovic Courtès
parent
b7d8dc5841
commit
085a8a0cdf
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
Loading…
Reference in New Issue