summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLiliana Marie Prikler <liliana.prikler@gmail.com>2025-06-29 15:20:47 +0200
committerLiliana Marie Prikler <liliana.prikler@gmail.com>2025-07-13 13:54:01 +0200
commitabbdfbb775d31c5ccc4f11abcb3650d123e28cc2 (patch)
tree2a4a13cf121e3fa71368cc3dba9281f349eab266 /guix
parent464c3b63401f213a13870146f4e592734972b54b (diff)
gnu: Rename minetest to luanti.
* gnu/packages/luanti.scm: New file. (luanti, luanti-server, luanti-topic, luanti-moreores, luanti-sound-api-core) (luanti-basic-materials, luanti-coloredwood, luanti-ethereal) (luanti-homedecor-modpack, luanti-mesecons, luanti-mineclone, luanti-mobs) (luanti-mobs-animal, luanti-mobs-monster, luanti-pipeworks, luanti-technic) (luanti-throwing, luanti-throwing-arrows, luanti-worldedit) (luanti-unifieddyes, luanti-unified-inventory, luanti-advtrains) (luanti-basic-trains, luanti-oneblock, luanti-wielded-light): New variables. * gnu/packages/minetest.scm: (minetest, minetest-server, minetest-topic, minetest-moreores) (minetest-sound-api-core, minetest-basic-materials, minetest-coloredwood) (minetest-ethereal, minetest-homedecor-modpack, minetest-mesecons) (minetest-mineclone, minetest-mobs, minetest-mobs-animal) (minetest-mobs-monster, minetest-pipeworks, minetest-technic) (minetest-throwing, minetest-throwing-arrows, minetest-worldedit) (minetest-unifieddyes, minetest-unified-inventory, minetest-advtrains) (minetest-basic-trains, minetest-oneblock, minetest-wielded-light): Deprecate in favor of the above. (minetest-game): Move to… * gnu/packages/luanti.scm (minetest-game): … here. * gnu/local.mk (GNU_SYSTEM_MODULES): Register luanti.scm. * guix/build-system/luanti.scm: New file. (luanti-mod-build-system): New public variable. * guix/build-system/minetest.scm (minetest-mod-build-system): Deprecate in favor of luanti-mod-build-system. * guix/build/luanti-build-system.scm: New file, renamed from… * guix/build/minetest-build-system.scm: … this. Deprecate in favor of luanti-build-system. * guix/import/luanti.scm: New file, renamed from guix/import/minetest.scm. (%contentdb-api): Switch to “https://content.luanti.org/api/”. (luanti-package?, latest-luanti-release, luanti->guix-package) (luanti-recursive-import, %luanti-updater): New public variables. * guix/import/minetest.scm (minetest-package?, latest-minetest-release) (minetest->guix-package, minetest-recursive-import, %minetest-updater): Deprecate in favor of the luanti variants above. * guix/scripts/import/luanti.scm: New file, renamed from guix/scripts/import/minetest.scm. (guix-import-luanti): New public variable. * guix/scripts/import/minetest.scm (guix-import-minetest): Deprecate in favor of guix-import-luanti. * tests/minetest.scm: Rename to… * tests/luanti.scm: … this. * Makefile.am (MODULES, SCM_TESTS): Adjust accordingly. * etc/teams.scm (games): Adjust accordingly. * CODEOWNERS: Adjust accordingly.
Diffstat (limited to 'guix')
-rw-r--r--guix/build-system/luanti.scm104
-rw-r--r--guix/build-system/minetest.scm86
-rw-r--r--guix/build/luanti-build-system.scm228
-rw-r--r--guix/build/minetest-build-system.scm214
-rw-r--r--guix/import/luanti.scm520
-rw-r--r--guix/import/minetest.scm517
-rw-r--r--guix/scripts/import.scm3
-rw-r--r--guix/scripts/import/luanti.scm118
-rw-r--r--guix/scripts/import/minetest.scm99
9 files changed, 1008 insertions, 881 deletions
diff --git a/guix/build-system/luanti.scm b/guix/build-system/luanti.scm
new file mode 100644
index 0000000000..89469162da
--- /dev/null
+++ b/guix/build-system/luanti.scm
@@ -0,0 +1,104 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;;
+;;; 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 build-system luanti)
+ #:use-module (guix build-system copy)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix build-system)
+ #:use-module (guix utils)
+ #:export (luanti-mod-build-system))
+
+;;
+;; Build procedure for luanti mods. This is implemented as an extension
+;; of ‘copy-build-system’.
+;;
+;; Code:
+
+;; Lazily resolve the bindings to avoid circular dependencies.
+(define (default-optipng)
+ ;; Lazily resolve the binding to avoid a circular dependency.
+ (module-ref (resolve-interface '(gnu packages image)) 'optipng))
+
+(define (default-luanti)
+ (module-ref (resolve-interface '(gnu packages luanti)) 'luanti))
+
+(define (default-luanti-game)
+ (module-ref (resolve-interface '(gnu packages luanti)) 'minetest-game))
+
+(define (default-xvfb-run)
+ (module-ref (resolve-interface '(gnu packages xorg)) 'xvfb-run))
+
+(define %luanti-build-system-modules
+ ;; Build-side modules imported by default.
+ `((guix build luanti-build-system)
+ ,@%copy-build-system-modules))
+
+(define %default-modules
+ ;; Modules in scope in the build-side environment.
+ '((guix build gnu-build-system)
+ (guix build luanti-build-system)
+ (guix build utils)))
+
+(define (standard-luanti-packages)
+ "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
+standard packages used as implicit inputs of the Luanti build system."
+ `(("xvfb-run" ,(default-xvfb-run))
+ ("optipng" ,(default-optipng))
+ ("luanti" ,(default-luanti))
+ ("luanti-game" ,(default-luanti-game))
+ ,@(filter (lambda (input)
+ (member (car input)
+ '("libc" "tar" "gzip" "bzip2" "xz" "locales")))
+ (standard-packages))))
+
+(define* (lower-mod name #:key (implicit-inputs? #t) #:allow-other-keys
+ #:rest arguments)
+ (define lower (build-system-lower gnu-build-system))
+ (apply lower
+ name
+ (substitute-keyword-arguments arguments
+ ;; luanti-mod-build-system adds implicit inputs by itself,
+ ;; so don't let gnu-build-system add its own implicit inputs
+ ;; as well.
+ ((#:implicit-inputs? implicit-inputs? #t)
+ #f)
+ ((#:implicit-cross-inputs? implicit-cross-inputs? #t)
+ #f)
+ ((#:imported-modules imported-modules %luanti-build-system-modules)
+ imported-modules)
+ ((#:modules modules %default-modules)
+ modules)
+ ((#:phases phases '%standard-phases)
+ phases)
+ ;; Ensure nothing sneaks into the closure.
+ ((#:allowed-references allowed-references '())
+ allowed-references)
+ ;; Add the implicit inputs.
+ ((#:native-inputs native-inputs '())
+ (if implicit-inputs?
+ (append native-inputs (standard-luanti-packages))
+ native-inputs)))))
+
+(define luanti-mod-build-system
+ (build-system
+ (name 'luanti-mod)
+ (description "The build system for Luanti mods")
+ (lower lower-mod)))
+
+;;; luanti.scm ends here
diff --git a/guix/build-system/minetest.scm b/guix/build-system/minetest.scm
index 9774c5882a..775e609177 100644
--- a/guix/build-system/minetest.scm
+++ b/guix/build-system/minetest.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,87 +18,8 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build-system minetest)
- #:use-module (guix build-system copy)
- #:use-module (guix build-system gnu)
- #:use-module (guix build-system)
- #:use-module (guix utils)
+ #:use-module (guix build-system luanti)
+ #:use-module (guix deprecation)
#:export (minetest-mod-build-system))
-;;
-;; Build procedure for minetest mods. This is implemented as an extension
-;; of ‘copy-build-system’.
-;;
-;; Code:
-
-;; Lazily resolve the bindings to avoid circular dependencies.
-(define (default-optipng)
- ;; Lazily resolve the binding to avoid a circular dependency.
- (module-ref (resolve-interface '(gnu packages image)) 'optipng))
-
-(define (default-minetest)
- (module-ref (resolve-interface '(gnu packages minetest)) 'minetest))
-
-(define (default-minetest-game)
- (module-ref (resolve-interface '(gnu packages minetest)) 'minetest-game))
-
-(define (default-xvfb-run)
- (module-ref (resolve-interface '(gnu packages xorg)) 'xvfb-run))
-
-(define %minetest-build-system-modules
- ;; Build-side modules imported by default.
- `((guix build minetest-build-system)
- ,@%copy-build-system-modules))
-
-(define %default-modules
- ;; Modules in scope in the build-side environment.
- '((guix build gnu-build-system)
- (guix build minetest-build-system)
- (guix build utils)))
-
-(define (standard-minetest-packages)
- "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of
-standard packages used as implicit inputs of the Minetest build system."
- `(("xvfb-run" ,(default-xvfb-run))
- ("optipng" ,(default-optipng))
- ("minetest" ,(default-minetest))
- ("minetest-game" ,(default-minetest-game))
- ,@(filter (lambda (input)
- (member (car input)
- '("libc" "tar" "gzip" "bzip2" "xz" "locales")))
- (standard-packages))))
-
-(define* (lower-mod name #:key (implicit-inputs? #t) #:allow-other-keys
- #:rest arguments)
- (define lower (build-system-lower gnu-build-system))
- (apply lower
- name
- (substitute-keyword-arguments arguments
- ;; minetest-mod-build-system adds implicit inputs by itself,
- ;; so don't let gnu-build-system add its own implicit inputs
- ;; as well.
- ((#:implicit-inputs? implicit-inputs? #t)
- #f)
- ((#:implicit-cross-inputs? implicit-cross-inputs? #t)
- #f)
- ((#:imported-modules imported-modules %minetest-build-system-modules)
- imported-modules)
- ((#:modules modules %default-modules)
- modules)
- ((#:phases phases '%standard-phases)
- phases)
- ;; Ensure nothing sneaks into the closure.
- ((#:allowed-references allowed-references '())
- allowed-references)
- ;; Add the implicit inputs.
- ((#:native-inputs native-inputs '())
- (if implicit-inputs?
- (append native-inputs (standard-minetest-packages))
- native-inputs)))))
-
-(define minetest-mod-build-system
- (build-system
- (name 'minetest-mod)
- (description "The build system for minetest mods")
- (lower lower-mod)))
-
-;;; minetest.scm ends here
+(define-deprecated/alias minetest-mod-build-system luanti-mod-build-system)
diff --git a/guix/build/luanti-build-system.scm b/guix/build/luanti-build-system.scm
new file mode 100644
index 0000000000..212f84f16f
--- /dev/null
+++ b/guix/build/luanti-build-system.scm
@@ -0,0 +1,228 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;;
+;;; 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 build luanti-build-system)
+ #:use-module (guix build utils)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 rdelim)
+ #:use-module (ice-9 receive)
+ #:use-module (ice-9 regex)
+ #:use-module (ice-9 exceptions)
+ #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+ #:use-module ((guix build copy-build-system) #:prefix copy:)
+ #:export (%standard-phases
+ mod-install-plan minimise-png read-mod-name check))
+
+;; (guix build copy-build-system) does not export 'install'.
+(define copy:install
+ (assoc-ref copy:%standard-phases 'install))
+
+(define (mod-install-plan mod-name)
+ `(("." ,(string-append "share/luanti/mods/" mod-name)
+ ;; Only install files that will actually be used at run time.
+ ;; This can save a little disk space.
+ ;;
+ ;; See <https://github.com/luanti/luanti/blob/master/doc/lua_api.txt>
+ ;; for an incomple list of files that can be found in mods.
+ #:include ("mod.conf" "modpack.conf" "settingtypes.txt" "depends.txt"
+ "description.txt" "config.txt" "_config.txt")
+ #:include-regexp (".lua$" ".png$" ".ogg$" ".obj$" ".b3d$" ".tr$"
+ ".mts$"))))
+
+(define* (guess-mod-name #:key inputs #:allow-other-keys)
+ "Try to determine the name of the mod or modpack that is being built.
+If it is unknown, make an educated guess."
+ ;; Luanti doesn't care about the directory names in "share/luanti/mods"
+ ;; so there is no technical problem if the directory names don't match
+ ;; the mod names. The directory can appear in the GUI if the modpack
+ ;; doesn't have the 'name' set though, so try to make a guess.
+ (define (guess)
+ (let* ((source (assoc-ref inputs "source"))
+ ;; Don't retain a reference to the store.
+ (file-name (strip-store-file-name source))
+ ;; The "luanti-" prefix is not informative, so strip it.
+ (file-name (if (string-prefix? "luanti-" file-name)
+ (substring file-name (string-length "luanti-"))
+ file-name))
+ ;; Strip "-checkout" suffixes of git checkouts.
+ (file-name (if (string-suffix? "-checkout" file-name)
+ (substring file-name
+ 0
+ (- (string-length file-name)
+ (string-length "-checkout")))
+ file-name))
+ (first-dot (string-index file-name #\.))
+ ;; If the source code is in an archive (.tar.gz, .zip, ...),
+ ;; strip the extension.
+ (file-name (if first-dot
+ (substring file-name 0 first-dot)
+ file-name)))
+ (format (current-error-port)
+ "warning: the modpack ~a did not set 'name' in 'modpack.conf'~%"
+ file-name)
+ file-name))
+ (cond ((file-exists? "mod.conf")
+ ;; Mods must have 'name' set in "mod.conf", so don't guess.
+ (read-mod-name "mod.conf"))
+ ((file-exists? "modpack.conf")
+ ;; While it is recommended to have 'name' set in 'modpack.conf',
+ ;; it is optional, so guess a name if necessary.
+ (read-mod-name "modpack.conf" guess))
+ (#t (guess))))
+
+(define* (install #:key inputs #:allow-other-keys #:rest arguments)
+ (apply copy:install
+ #:install-plan (mod-install-plan (apply guess-mod-name arguments))
+ arguments))
+
+(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
+ "Minimise PNG images found in the working directory."
+ (define optipng (which "optipng"))
+ (define (optimise image)
+ (format #t "Optimising ~a~%" image)
+ (make-file-writable (dirname image))
+ (make-file-writable image)
+ (define old-size (stat:size (stat image)))
+ ;; The mod "technic" has a file "technic_music_player_top.png" that
+ ;; actually is a JPEG file, see
+ ;; <https://github.com/luanti-mods/technic/issues/590>.
+ (if (png-file? image)
+ (invoke optipng "-o4" "-quiet" image)
+ (format #t "warning: skipping ~a because it's not actually a PNG image~%"
+ image))
+ (define new-size (stat:size (stat image)))
+ (values old-size new-size))
+ (define files (find-files "." ".png$"))
+ (let loop ((total-old-size 0)
+ (total-new-size 0)
+ (images (find-files "." ".png$")))
+ (cond ((pair? images)
+ (receive (old-size new-size)
+ (optimise (car images))
+ (loop (+ total-old-size old-size)
+ (+ total-new-size new-size)
+ (cdr images))))
+ ((= total-old-size 0)
+ (format #t "There were no PNG images to minimise."))
+ (#t
+ (format #t "Minimisation reduced size of images by ~,2f% (~,2f MiB to ~,2f MiB)~%"
+ (* 100.0 (- 1 (/ total-new-size total-old-size)))
+ (/ total-old-size (expt 1024 2))
+ (/ total-new-size (expt 1024 2)))))))
+
+(define name-regexp
+ (make-regexp "^name[[:space:]]*=[[:space:]]*([[:graph:]]+)[[:space:]]*$"))
+
+(define* (read-mod-name mod.conf #:optional not-found)
+ "Read the name of a mod from MOD.CONF. If MOD.CONF
+does not have a name field and NOT-FOUND is #false, raise an
+error. If NOT-FOUND is TRUE, call NOT-FOUND instead."
+ (call-with-input-file mod.conf
+ (lambda (port)
+ (let loop ()
+ (define line (read-line port))
+ (if (eof-object? line)
+ (if not-found
+ (not-found)
+ (error "~a does not have a 'name' field" mod.conf))
+ (let ((match (regexp-exec name-regexp line)))
+ (if (regexp-match? match)
+ (string-trim-both (match:substring match 1) #\ )
+ (loop))))))))
+
+(define* (check #:key outputs tests? #:allow-other-keys)
+ "Test whether the mod loads. The mod must first be installed first."
+ (define (all-mod-names directories)
+ (append-map
+ (lambda (directory)
+ (map read-mod-name (find-files directory "mod.conf")))
+ directories))
+ (when tests?
+ (mkdir "guix_testworld")
+ ;; Add the mod to the mod search path, such that Luanti can find it.
+ (setenv "MINETEST_MOD_PATH"
+ (list->search-path-as-string
+ (cons
+ (string-append (assoc-ref outputs "out") "/share/luanti/mods")
+ (search-path-as-string->list
+ (or (getenv "MINETEST_MOD_PATH") "")))
+ ":"))
+ (with-directory-excursion "guix_testworld"
+ (setenv "HOME" (getcwd))
+ ;; Create a world in which all mods are loaded.
+ (call-with-output-file "world.mt"
+ (lambda (port)
+ (display
+ "gameid = minetest
+world_name = guix_testworld
+backend = sqlite3
+player_backend = sqlite3
+auth_backend = sqlite3
+" port)
+ (for-each
+ (lambda (mod)
+ (format port "load_mod_~a = true~%" mod))
+ (all-mod-names (search-path-as-string->list
+ (getenv "MINETEST_MOD_PATH"))))))
+ (receive (port pid)
+ ((@@ (guix build utils) open-pipe-with-stderr)
+ "xvfb-run" "--" "luanti" "--info" "--world" "." "--go")
+ (format #t "Started Luanti with all mods loaded for testing~%")
+ ;; Scan the output for error messages.
+ ;; When the player has joined the server, stop luanti.
+ (define (error? line)
+ (and (string? line)
+ (string-contains line ": ERROR[")))
+ (define (stop? line)
+ (and (string? line)
+ (string-contains line "ACTION[Server]: singleplayer [127.0.0.1] joins game.")))
+ (let loop ((has-errors? #f))
+ (match `(,(read-line port) ,has-errors?)
+ (((? error? line) _)
+ (display line)
+ (newline)
+ (loop #t))
+ (((? stop?) #f)
+ (kill pid SIGINT)
+ (close-port port)
+ (waitpid pid))
+ (((? eof-object?) #f)
+ (error "luanti didn't start"))
+ (((or (? stop?) (? eof-object?)) #t)
+ (error "luanti raised an error"))
+ (((? string? line) has-error?)
+ (display line)
+ (newline)
+ (loop has-error?))))))))
+
+(define %standard-phases
+ (modify-phases gnu:%standard-phases
+ (delete 'bootstrap)
+ (delete 'configure)
+ (add-before 'build 'minimise-png minimise-png)
+ (delete 'build)
+ (delete 'check)
+ (replace 'install install)
+ ;; The 'check' phase requires the mod to be installed,
+ ;; so move the 'check' phase after the 'install' phase.
+ (add-after 'install 'check check)))
+
+;;; luanti-build-system.scm ends here
diff --git a/guix/build/minetest-build-system.scm b/guix/build/minetest-build-system.scm
index 305e9dc1ba..007ff396f6 100644
--- a/guix/build/minetest-build-system.scm
+++ b/guix/build/minetest-build-system.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,211 +18,10 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix build minetest-build-system)
- #:use-module (guix build utils)
- #:use-module (srfi srfi-1)
- #:use-module (ice-9 format)
- #:use-module (ice-9 match)
- #:use-module (ice-9 rdelim)
- #:use-module (ice-9 receive)
- #:use-module (ice-9 regex)
- #:use-module (ice-9 exceptions)
- #:use-module ((guix build gnu-build-system) #:prefix gnu:)
- #:use-module ((guix build copy-build-system) #:prefix copy:)
- #:export (%standard-phases
- mod-install-plan minimise-png read-mod-name check))
+ #:use-module (guix build luanti-build-system)
+ #:use-module (guix deprecation)
+ #:re-export (%standard-phases
+ mod-install-plan minimise-png read-mod-name check))
-;; (guix build copy-build-system) does not export 'install'.
-(define copy:install
- (assoc-ref copy:%standard-phases 'install))
-
-(define (mod-install-plan mod-name)
- `(("." ,(string-append "share/minetest/mods/" mod-name)
- ;; Only install files that will actually be used at run time.
- ;; This can save a little disk space.
- ;;
- ;; See <https://github.com/minetest/minetest/blob/master/doc/lua_api.txt>
- ;; for an incomple list of files that can be found in mods.
- #:include ("mod.conf" "modpack.conf" "settingtypes.txt" "depends.txt"
- "description.txt" "config.txt" "_config.txt")
- #:include-regexp (".lua$" ".png$" ".ogg$" ".obj$" ".b3d$" ".tr$"
- ".mts$"))))
-
-(define* (guess-mod-name #:key inputs #:allow-other-keys)
- "Try to determine the name of the mod or modpack that is being built.
-If it is unknown, make an educated guess."
- ;; Minetest doesn't care about the directory names in "share/minetest/mods"
- ;; so there is no technical problem if the directory names don't match
- ;; the mod names. The directory can appear in the GUI if the modpack
- ;; doesn't have the 'name' set though, so try to make a guess.
- (define (guess)
- (let* ((source (assoc-ref inputs "source"))
- ;; Don't retain a reference to the store.
- (file-name (strip-store-file-name source))
- ;; The "minetest-" prefix is not informative, so strip it.
- (file-name (if (string-prefix? "minetest-" file-name)
- (substring file-name (string-length "minetest-"))
- file-name))
- ;; Strip "-checkout" suffixes of git checkouts.
- (file-name (if (string-suffix? "-checkout" file-name)
- (substring file-name
- 0
- (- (string-length file-name)
- (string-length "-checkout")))
- file-name))
- (first-dot (string-index file-name #\.))
- ;; If the source code is in an archive (.tar.gz, .zip, ...),
- ;; strip the extension.
- (file-name (if first-dot
- (substring file-name 0 first-dot)
- file-name)))
- (format (current-error-port)
- "warning: the modpack ~a did not set 'name' in 'modpack.conf'~%"
- file-name)
- file-name))
- (cond ((file-exists? "mod.conf")
- ;; Mods must have 'name' set in "mod.conf", so don't guess.
- (read-mod-name "mod.conf"))
- ((file-exists? "modpack.conf")
- ;; While it is recommended to have 'name' set in 'modpack.conf',
- ;; it is optional, so guess a name if necessary.
- (read-mod-name "modpack.conf" guess))
- (#t (guess))))
-
-(define* (install #:key inputs #:allow-other-keys #:rest arguments)
- (apply copy:install
- #:install-plan (mod-install-plan (apply guess-mod-name arguments))
- arguments))
-
-(define* (minimise-png #:key inputs native-inputs #:allow-other-keys)
- "Minimise PNG images found in the working directory."
- (define optipng (which "optipng"))
- (define (optimise image)
- (format #t "Optimising ~a~%" image)
- (make-file-writable (dirname image))
- (make-file-writable image)
- (define old-size (stat:size (stat image)))
- ;; The mod "technic" has a file "technic_music_player_top.png" that
- ;; actually is a JPEG file, see
- ;; <https://github.com/minetest-mods/technic/issues/590>.
- (if (png-file? image)
- (invoke optipng "-o4" "-quiet" image)
- (format #t "warning: skipping ~a because it's not actually a PNG image~%"
- image))
- (define new-size (stat:size (stat image)))
- (values old-size new-size))
- (define files (find-files "." ".png$"))
- (let loop ((total-old-size 0)
- (total-new-size 0)
- (images (find-files "." ".png$")))
- (cond ((pair? images)
- (receive (old-size new-size)
- (optimise (car images))
- (loop (+ total-old-size old-size)
- (+ total-new-size new-size)
- (cdr images))))
- ((= total-old-size 0)
- (format #t "There were no PNG images to minimise."))
- (#t
- (format #t "Minimisation reduced size of images by ~,2f% (~,2f MiB to ~,2f MiB)~%"
- (* 100.0 (- 1 (/ total-new-size total-old-size)))
- (/ total-old-size (expt 1024 2))
- (/ total-new-size (expt 1024 2)))))))
-
-(define name-regexp
- (make-regexp "^name[[:space:]]*=[[:space:]]*([[:graph:]]+)[[:space:]]*$"))
-
-(define* (read-mod-name mod.conf #:optional not-found)
- "Read the name of a mod from MOD.CONF. If MOD.CONF
-does not have a name field and NOT-FOUND is #false, raise an
-error. If NOT-FOUND is TRUE, call NOT-FOUND instead."
- (call-with-input-file mod.conf
- (lambda (port)
- (let loop ()
- (define line (read-line port))
- (if (eof-object? line)
- (if not-found
- (not-found)
- (error "~a does not have a 'name' field" mod.conf))
- (let ((match (regexp-exec name-regexp line)))
- (if (regexp-match? match)
- (string-trim-both (match:substring match 1) #\ )
- (loop))))))))
-
-(define* (check #:key outputs tests? #:allow-other-keys)
- "Test whether the mod loads. The mod must first be installed first."
- (define (all-mod-names directories)
- (append-map
- (lambda (directory)
- (map read-mod-name (find-files directory "mod.conf")))
- directories))
- (when tests?
- (mkdir "guix_testworld")
- ;; Add the mod to the mod search path, such that Minetest can find it.
- (setenv "MINETEST_MOD_PATH"
- (list->search-path-as-string
- (cons
- (string-append (assoc-ref outputs "out") "/share/minetest/mods")
- (search-path-as-string->list
- (or (getenv "MINETEST_MOD_PATH") "")))
- ":"))
- (with-directory-excursion "guix_testworld"
- (setenv "HOME" (getcwd))
- ;; Create a world in which all mods are loaded.
- (call-with-output-file "world.mt"
- (lambda (port)
- (display
- "gameid = minetest
-world_name = guix_testworld
-backend = sqlite3
-player_backend = sqlite3
-auth_backend = sqlite3
-" port)
- (for-each
- (lambda (mod)
- (format port "load_mod_~a = true~%" mod))
- (all-mod-names (search-path-as-string->list
- (getenv "MINETEST_MOD_PATH"))))))
- (receive (port pid)
- ((@@ (guix build utils) open-pipe-with-stderr)
- "xvfb-run" "--" "minetest" "--info" "--world" "." "--go")
- (format #t "Started Minetest with all mods loaded for testing~%")
- ;; Scan the output for error messages.
- ;; When the player has joined the server, stop minetest.
- (define (error? line)
- (and (string? line)
- (string-contains line ": ERROR[")))
- (define (stop? line)
- (and (string? line)
- (string-contains line "ACTION[Server]: singleplayer [127.0.0.1] joins game.")))
- (let loop ((has-errors? #f))
- (match `(,(read-line port) ,has-errors?)
- (((? error? line) _)
- (display line)
- (newline)
- (loop #t))
- (((? stop?) #f)
- (kill pid SIGINT)
- (close-port port)
- (waitpid pid))
- (((? eof-object?) #f)
- (error "minetest didn't start"))
- (((or (? stop?) (? eof-object?)) #t)
- (error "minetest raised an error"))
- (((? string? line) has-error?)
- (display line)
- (newline)
- (loop has-error?))))))))
-
-(define %standard-phases
- (modify-phases gnu:%standard-phases
- (delete 'bootstrap)
- (delete 'configure)
- (add-before 'build 'minimise-png minimise-png)
- (delete 'build)
- (delete 'check)
- (replace 'install install)
- ;; The 'check' phase requires the mod to be installed,
- ;; so move the 'check' phase after the 'install' phase.
- (add-after 'install 'check check)))
-
-;;; minetest-build-system.scm ends here
+(warn-about-deprecation '(guix build minetest-build-system) #f
+ #:replacement '(guix build luanti-build-system))
diff --git a/guix/import/luanti.scm b/guix/import/luanti.scm
new file mode 100644
index 0000000000..1db660655e
--- /dev/null
+++ b/guix/import/luanti.scm
@@ -0,0 +1,520 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;;
+;;; 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 luanti)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 threads)
+ #:use-module (ice-9 hash-table)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (guix diagnostics)
+ #:use-module ((guix packages) #:prefix package:)
+ #:use-module (guix upstream)
+ #:use-module (guix i18n)
+ #:use-module (guix memoization)
+ #:use-module (guix serialization)
+ #:use-module (guix import utils)
+ #:use-module (guix import json)
+ #:use-module (json)
+ #:use-module (guix base32)
+ #:use-module (guix git)
+ #:use-module ((guix git-download) #:prefix download:)
+ #:use-module (guix hash)
+ #:use-module (guix store)
+ #:export (%default-sort-key
+ %contentdb-api
+ json->package
+ contentdb-fetch
+ elaborate-contentdb-name
+ luanti-package?
+ latest-luanti-release
+ luanti->guix-package
+ luanti-recursive-import
+ sort-packages
+ %luanti-updater))
+
+;; The ContentDB API is documented at
+;; <https://content.luanti.net>.
+
+(define %contentdb-api
+ (make-parameter "https://content.luanti.org/api/"))
+
+(define (string-or-false x)
+ (and (string? x) x))
+
+(define (natural-or-false x)
+ (and (exact-integer? x) (>= x 0) x))
+
+;; Descriptions on ContentDB use carriage returns, but Guix doesn't.
+(define (delete-cr text)
+ (string-delete #\cr text))
+
+
+
+;;;
+;;; JSON mappings
+;;;
+
+;; Luanti package.
+;;
+;; API endpoint: /packages/AUTHOR/NAME/
+(define-json-mapping <package> make-package package?
+ json->package
+ (author package-author) ; string
+ (creation-date package-creation-date ; string
+ "created_at")
+ (downloads package-downloads) ; integer
+ (forums package-forums "forums" natural-or-false)
+ (issue-tracker package-issue-tracker "issue_tracker") ; string
+ (license package-license) ; string
+ (long-description package-long-description "long_description") ; string
+ (maintainers package-maintainers ; list of strings
+ "maintainers" vector->list)
+ (media-license package-media-license "media_license") ; string
+ (name package-name) ; string
+ (provides package-provides ; list of strings
+ "provides" vector->list)
+ (release package-release) ; integer
+ (repository package-repository "repo" string-or-false)
+ (score package-score) ; flonum
+ (screenshots package-screenshots "screenshots" vector->list) ; list of strings
+ (short-description package-short-description "short_description") ; string
+ (state package-state) ; string
+ (tags package-tags "tags" vector->list) ; list of strings
+ (thumbnail package-thumbnail) ; string
+ (title package-title) ; string
+ (type package-type) ; string
+ (url package-url) ; string
+ (website package-website "website" string-or-false))
+
+(define-json-mapping <release> make-release release?
+ json->release
+ ;; If present, a git commit identified by its hash
+ (commit release-commit "commit" string-or-false)
+ (downloads release-downloads) ; integer
+ (id release-id) ; integer
+ (max-luanti-version release-max-luanti-version string-or-false)
+ (min-luanti-version release-min-luanti-version string-or-false)
+ (release-date release-data) ; string
+ (title release-title) ; string
+ (url release-url)) ; string
+
+(define-json-mapping <dependency> make-dependency dependency?
+ json->dependency
+ (optional? dependency-optional? "is_optional") ; bool
+ (name dependency-name) ; string
+ (packages dependency-packages "packages" vector->list)) ; list of strings
+
+;; A structure returned by the /api/packages/?fmt=keys endpoint
+(define-json-mapping <package-keys> make-package-keys package-keys?
+ json->package-keys
+ (author package-keys-author) ; string
+ (name package-keys-name) ; string
+ (type package-keys-type)) ; string
+
+(define (package-mod? package)
+ "Is the ContentDB package PACKAGE a mod?"
+ ;; ContentDB also has ‘games’ and ‘texture packs’.
+ (string=? (package-type package) "mod"))
+
+
+
+;;;
+;;; Manipulating names of packages
+;;;
+;;; There are three kind of names:
+;;;
+;;; * names of guix packages, e.g. luanti-basic-materials.
+;;; * names of mods on ContentDB, e.g. basic_materials
+;;; * a combination of author and mod name on ContentDB, e.g. VanessaE/basic_materials
+;;;
+
+(define (%construct-full-name author name)
+ (string-append author "/" name))
+
+(define (package-full-name package)
+ "Given a <package> object, return the corresponding AUTHOR/NAME string."
+ (%construct-full-name (package-author package) (package-name package)))
+
+(define (package-keys-full-name package)
+ "Given a <package-keys> object, return the corresponding AUTHOR/NAME string."
+ (%construct-full-name (package-keys-author package)
+ (package-keys-name package)))
+
+(define (contentdb->package-name author/name)
+ "Given the AUTHOR/NAME of a package on ContentDB, return a Guix-compliant
+name for the package."
+ ;; The author is not included, as the names of popular mods
+ ;; tend to be unique.
+ (string-append "luanti-" (snake-case (author/name->name author/name))))
+
+(define (author/name->name author/name)
+ "Extract NAME from the AUTHOR/NAME string, or raise an error if AUTHOR/NAME
+is ill-formatted."
+ (match (string-split author/name #\/)
+ ((author name)
+ (when (string-null? author)
+ (leave
+ (G_ "In ~a: author names must consist of at least a single character.~%")
+ author/name))
+ (when (string-null? name)
+ (leave
+ (G_ "In ~a: mod names must consist of at least a single character.~%")
+ author/name))
+ name)
+ ((too many . components)
+ (leave
+ (G_ "In ~a: author names and mod names may not contain forward slashes.~%")
+ author/name))
+ ((name)
+ (if (string-null? name)
+ (leave (G_ "mod names may not be empty.~%"))
+ (leave (G_ "The name of the author is missing in ~a.~%")
+ author/name)))))
+
+(define* (elaborate-contentdb-name name #:key (sort %default-sort-key))
+ "If NAME is an AUTHOR/NAME string, return it. Otherwise, try to determine
+the author and return an appropriate AUTHOR/NAME string. If that fails,
+raise an exception."
+ (if (or (string-contains name "/") (string-null? name))
+ ;; Call 'author/name->name' to verify that NAME seems reasonable
+ ;; and raise an appropriate exception if it isn't.
+ (begin
+ (author/name->name name)
+ name)
+ (let* ((package-keys (contentdb-query-packages name #:sort sort))
+ (correctly-named
+ (filter (lambda (package-key)
+ (string=? name (package-keys-name package-key)))
+ package-keys)))
+ (match correctly-named
+ ((one) (package-keys-full-name one))
+ ((too . many)
+ (warning (G_ "~a is ambiguous, presuming ~a (other options include: ~a)~%")
+ name (package-keys-full-name too)
+ (map package-keys-full-name many))
+ (package-keys-full-name too))
+ (()
+ (leave (G_ "No mods with name ~a were found.~%") name))))))
+
+
+
+;;;
+;;; API endpoints
+;;;
+
+(define contentdb-fetch
+ (mlambda (author/name)
+ "Return a <package> record for package AUTHOR/NAME, or #f on failure."
+ (and=> (json-fetch
+ (string-append (%contentdb-api) "packages/" author/name "/"))
+ json->package)))
+
+(define (contentdb-fetch-releases author/name)
+ "Return a list of <release> records for package NAME by AUTHOR, or #f
+on failure."
+ (and=> (json-fetch (string-append (%contentdb-api) "packages/" author/name
+ "/releases/"))
+ (lambda (json)
+ (map json->release (vector->list json)))))
+
+(define (latest-release author/name)
+ "Return the latest source release for package NAME by AUTHOR,
+or #f if this package does not exist."
+ (and=> (contentdb-fetch-releases author/name)
+ car))
+
+(define (contentdb-fetch-dependencies author/name)
+ "Return an alist of lists of <dependency> records for package NAME by AUTHOR
+and possibly some other packages as well, or #f on failure."
+ (define url (string-append (%contentdb-api) "packages/" author/name
+ "/dependencies/"))
+ (and=> (json-fetch url)
+ (lambda (json)
+ (map (match-lambda
+ ((key . value)
+ (cons key (map json->dependency (vector->list value)))))
+ json))))
+
+(define* (contentdb-query-packages q #:key
+ (type "mod")
+ (limit 50)
+ (sort %default-sort-key)
+ (order "desc"))
+ "Search ContentDB for Q (a string). Sort by SORT, in ascending order
+if ORDER is \"asc\" or descending order if ORDER is \"desc\". TYPE must
+be \"mod\", \"game\" or \"txp\", restricting the search results to
+respectively mods, games and texture packs. Limit to at most LIMIT
+results. The return value is a list of <package-keys> records."
+ ;; XXX does Guile have something for constructing (and, when necessary,
+ ;; escaping) query strings?
+ (define url (string-append (%contentdb-api) "packages/?type=" type
+ "&q=" q "&fmt=keys"
+ "&limit=" (number->string limit)
+ "&order=" order
+ "&sort=" sort))
+ (let ((json (json-fetch url)))
+ (if json
+ (map json->package-keys (vector->list json))
+ (leave
+ (G_ "The package search API doesn't exist anymore.~%")))))
+
+
+
+;; XXX copied from (guix import elpa)
+(define* (download-git-repository url ref)
+ "Fetch the given REF from the Git repository at URL."
+ (with-store store
+ (latest-repository-commit store url #:ref ref)))
+
+(define (make-luanti-sexp author/name version repository commit
+ inputs home-page synopsis
+ description media-license license)
+ "Return a S-expression for the luanti package with the given author/NAME,
+VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
+MEDIA-LICENSE and LICENSE."
+ `(package
+ (name ,(contentdb->package-name author/name))
+ (version ,version)
+ (source
+ (origin
+ (method git-fetch)
+ (uri (git-reference
+ (url ,repository)
+ (commit ,commit)))
+ (sha256
+ (base32
+ ;; The git commit is not always available.
+ ,(and commit
+ (bytevector->nix-base32-string
+ (file-hash*
+ (download-git-repository repository
+ `(commit . ,commit))
+ ;; 'download-git-repository' already filtered out the '.git'
+ ;; directory.
+ #:select? (const #true)
+ #:recursive? #true)))))
+ (file-name (git-file-name name version))))
+ (build-system luanti-mod-build-system)
+ ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
+ (home-page ,home-page)
+ (synopsis ,(delete-cr synopsis))
+ (description ,(beautify-description (delete-cr description)))
+ (license ,(if (eq? media-license license)
+ license
+ `(list ,media-license ,license)))
+ ;; The Luanti updater (not yet in Guix; it requires not-yet-submitted
+ ;; patches to (guix upstream) that require some work) needs to know both
+ ;; the author name and mod name for efficiency.
+ (properties ,(list 'quasiquote `((upstream-name . ,author/name))))))
+
+(define (package-home-page package)
+ "Guess the home page of the ContentDB package PACKAGE.
+
+In order of preference, try the 'website', the forum topic on the
+official Luanti forum and the Git repository (if any)."
+ (define (topic->url-sexp topic)
+ ;; 'luanti-topic' is a procedure defined in (gnu packages luanti)
+ `(luanti-topic ,topic))
+ (or (package-website package)
+ (and=> (package-forums package) topic->url-sexp)
+ (package-repository package)))
+
+(define (release-version release)
+ "Guess the version of RELEASE from the release title."
+ (define title (release-title release))
+ (if (string-prefix? "v" title)
+ ;; Remove "v" prefix from release titles like ‘v1.0.1’.
+ (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 luanti) appropriately as well.
+(define %default-sort-key "score")
+
+(define* (sort-packages packages #:key (sort %default-sort-key))
+ "Sort PACKAGES by SORT, in descending order."
+ (define package->key
+ (match sort
+ ("score" package-score)
+ ("downloads" package-downloads)))
+ (define (greater x y)
+ (> (package->key x) (package->key y)))
+ (sort-list packages greater))
+
+(define builtin-mod?
+ (let ((%builtin-mods
+ (alist->hash-table
+ (map (lambda (x) (cons x #t))
+ '("beds" "binoculars" "boats" "bones" "bucket" "butterflies"
+ "carts" "creative" "default" "doors" "dungeon_loot" "dye"
+ "env_sounds" "farming" "fire" "fireflies" "flowers"
+ "game_commands" "give_initial_stuff" "map" "mtg_craftguide"
+ "player_api" "screwdriver" "sethome" "sfinv" "spawn" "stairs"
+ "tnt" "vessels" "walls" "weather" "wool" "xpanes")))))
+ (lambda (mod)
+ "Is MOD provided by the default luanti subgame?"
+ (hash-ref %builtin-mods mod))))
+
+(define* (important-dependencies dependencies author/name
+ #:key (sort %default-sort-key))
+ "Return the hard dependencies of AUTHOR/NAME in the association list
+DEPENDENCIES as a list of AUTHOR/NAME strings."
+ (define dependency-list
+ (assoc-ref dependencies author/name))
+ ;; A mod can have multiple dependencies implemented by the same mod,
+ ;; so remove duplicate mod names.
+ (define (filter-deduplicate-map f list)
+ (delete-duplicates (filter-map f list)))
+ (filter-deduplicate-map
+ (lambda (dependency)
+ (and (not (dependency-optional? dependency))
+ (not (builtin-mod? (dependency-name dependency)))
+ ;; The dependency information contains symbolic names
+ ;; that can be ‘provided’ by multiple mods, so we need to choose one
+ ;; of the implementations.
+ (let* ((implementations
+ (par-map contentdb-fetch (dependency-packages dependency)))
+ ;; Fetching package information about the packages is racy:
+ ;; some packages might be removed from ContentDB between the
+ ;; construction of DEPENDENCIES and the call to
+ ;; 'contentdb-fetch'. So filter out #f.
+ ;;
+ ;; Filter out ‘games’ that include the requested mod -- it's
+ ;; the mod itself we want.
+ (mods (filter (lambda (p) (and=> p package-mod?))
+ implementations))
+ (sorted-mods (sort-packages mods #:sort sort)))
+ (match sorted-mods
+ ((package) (package-full-name package))
+ ((too . many)
+ (warning
+ (G_ "The dependency ~a of ~a has multiple different implementations ~a.~%")
+ (dependency-name dependency)
+ author/name
+ (map package-full-name sorted-mods))
+ (match sort
+ ("score"
+ (warning
+ (G_ "The implementation with the highest score will be chosen!~%")))
+ ("downloads"
+ (warning
+ (G_ "The implementation that has been downloaded the most will be chosen!~%"))))
+ (package-full-name too))
+ (()
+ (warning
+ (G_ "The dependency ~a of ~a does not have any implementation. It will be ignored!~%")
+ (dependency-name dependency) author/name)
+ #f)))))
+ dependency-list))
+
+(define* (%luanti->guix-package author/name #:key (sort %default-sort-key)
+ #:allow-other-keys)
+ "Fetch the metadata for AUTHOR/NAME from https://content.luanti.net, and
+return the 'package' S-expression corresponding to that package, or raise an
+exception on failure. On success, also return the upstream dependencies as a
+list of AUTHOR/NAME strings."
+ ;; Call 'author/name->name' to verify that AUTHOR/NAME seems reasonable.
+ (author/name->name author/name)
+ (define package (contentdb-fetch author/name))
+ (unless package
+ (leave (G_ "no package metadata for ~a on ContentDB~%") author/name))
+ (define dependencies (contentdb-fetch-dependencies author/name))
+ (unless dependencies
+ (leave (G_ "no dependency information for ~a on ContentDB~%") author/name))
+ (define release (latest-release author/name))
+ (unless release
+ (leave (G_ "no release of ~a on ContentDB~%") author/name))
+ (define important-upstream-dependencies
+ (important-dependencies dependencies author/name #:sort sort))
+ (values (make-luanti-sexp author/name
+ (release-version release)
+ (package-repository package)
+ (release-commit release)
+ important-upstream-dependencies
+ (package-home-page package)
+ (package-short-description package)
+ (package-long-description package)
+ (spdx-string->license
+ (package-media-license package))
+ (spdx-string->license
+ (package-license package)))
+ important-upstream-dependencies))
+
+(define luanti->guix-package
+ (memoize %luanti->guix-package))
+
+(define* (luanti-recursive-import author/name #:key (sort %default-sort-key))
+ (define* (luanti->guix-package* author/name #:key version #:allow-other-keys)
+ (luanti->guix-package author/name #:sort sort))
+ (recursive-import author/name
+ #:repo->guix-package luanti->guix-package*
+ #:guix-name contentdb->package-name))
+
+(define (luanti-package? pkg)
+ "Is PKG a Luanti mod on ContentDB?"
+ (and (string-prefix? "luanti-" (package:package-name pkg))
+ (assq-ref (package:package-properties pkg) 'upstream-name)))
+
+(define* (latest-luanti-release pkg #:key version partial-version?)
+ "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))
+
+ (when version
+ (raise
+ (formatted-message
+ (G_ "~a updater doesn't support updating to a specific version, sorry.")
+ "luanti")))
+ (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 (download:git-reference
+ (url (package-repository contentdb-package))
+ (commit (release-commit release)))))))
+
+(define %luanti-updater
+ (upstream-updater
+ (name 'luanti)
+ (description "Updater for Luanti packages on ContentDB")
+ (pred luanti-package?)
+ (import latest-luanti-release)))
diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm
index a46296cdc4..c20a673200 100644
--- a/guix/import/minetest.scm
+++ b/guix/import/minetest.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021, 2022 Maxime Devos <maximedevos@telenet.be>
;;; Copyright © 2022 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -18,502 +19,22 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix import minetest)
- #:use-module (ice-9 match)
- #:use-module (ice-9 threads)
- #:use-module (ice-9 hash-table)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-34)
- #:use-module (guix diagnostics)
- #:use-module ((guix packages) #:prefix package:)
- #:use-module (guix upstream)
- #:use-module (guix i18n)
- #:use-module (guix memoization)
- #:use-module (guix serialization)
- #:use-module (guix import utils)
- #:use-module (guix import json)
- #:use-module (json)
- #:use-module (guix base32)
- #:use-module (guix git)
- #:use-module ((guix git-download) #:prefix download:)
- #:use-module (guix hash)
- #: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
- %minetest-updater))
+ #:use-module (guix deprecation)
+ #:use-module (guix import luanti)
+ #:re-export (%default-sort-key
+ %contentdb-api
+ json->package
+ contentdb-fetch
+ elaborate-contentdb-name
+ sort-packages)
+ #:export (minetest-package?
+ latest-minetest-release
+ minetest->guix-package
+ minetest-recursive-import
+ %minetest-updater))
-;; The ContentDB API is documented at
-;; <https://content.minetest.net>.
-
-(define %contentdb-api
- (make-parameter "https://content.minetest.net/api/"))
-
-(define (string-or-false x)
- (and (string? x) x))
-
-(define (natural-or-false x)
- (and (exact-integer? x) (>= x 0) x))
-
-;; Descriptions on ContentDB use carriage returns, but Guix doesn't.
-(define (delete-cr text)
- (string-delete #\cr text))
-
-
-
-;;;
-;;; JSON mappings
-;;;
-
-;; Minetest package.
-;;
-;; API endpoint: /packages/AUTHOR/NAME/
-(define-json-mapping <package> make-package package?
- json->package
- (author package-author) ; string
- (creation-date package-creation-date ; string
- "created_at")
- (downloads package-downloads) ; integer
- (forums package-forums "forums" natural-or-false)
- (issue-tracker package-issue-tracker "issue_tracker") ; string
- (license package-license) ; string
- (long-description package-long-description "long_description") ; string
- (maintainers package-maintainers ; list of strings
- "maintainers" vector->list)
- (media-license package-media-license "media_license") ; string
- (name package-name) ; string
- (provides package-provides ; list of strings
- "provides" vector->list)
- (release package-release) ; integer
- (repository package-repository "repo" string-or-false)
- (score package-score) ; flonum
- (screenshots package-screenshots "screenshots" vector->list) ; list of strings
- (short-description package-short-description "short_description") ; string
- (state package-state) ; string
- (tags package-tags "tags" vector->list) ; list of strings
- (thumbnail package-thumbnail) ; string
- (title package-title) ; string
- (type package-type) ; string
- (url package-url) ; string
- (website package-website "website" string-or-false))
-
-(define-json-mapping <release> make-release release?
- json->release
- ;; If present, a git commit identified by its hash
- (commit release-commit "commit" string-or-false)
- (downloads release-downloads) ; integer
- (id release-id) ; integer
- (max-minetest-version release-max-minetest-version string-or-false)
- (min-minetest-version release-min-minetest-version string-or-false)
- (release-date release-data) ; string
- (title release-title) ; string
- (url release-url)) ; string
-
-(define-json-mapping <dependency> make-dependency dependency?
- json->dependency
- (optional? dependency-optional? "is_optional") ; bool
- (name dependency-name) ; string
- (packages dependency-packages "packages" vector->list)) ; list of strings
-
-;; A structure returned by the /api/packages/?fmt=keys endpoint
-(define-json-mapping <package-keys> make-package-keys package-keys?
- json->package-keys
- (author package-keys-author) ; string
- (name package-keys-name) ; string
- (type package-keys-type)) ; string
-
-(define (package-mod? package)
- "Is the ContentDB package PACKAGE a mod?"
- ;; ContentDB also has ‘games’ and ‘texture packs’.
- (string=? (package-type package) "mod"))
-
-
-
-;;;
-;;; Manipulating names of packages
-;;;
-;;; There are three kind of names:
-;;;
-;;; * names of guix packages, e.g. minetest-basic-materials.
-;;; * names of mods on ContentDB, e.g. basic_materials
-;;; * a combination of author and mod name on ContentDB, e.g. VanessaE/basic_materials
-;;;
-
-(define (%construct-full-name author name)
- (string-append author "/" name))
-
-(define (package-full-name package)
- "Given a <package> object, return the corresponding AUTHOR/NAME string."
- (%construct-full-name (package-author package) (package-name package)))
-
-(define (package-keys-full-name package)
- "Given a <package-keys> object, return the corresponding AUTHOR/NAME string."
- (%construct-full-name (package-keys-author package)
- (package-keys-name package)))
-
-(define (contentdb->package-name author/name)
- "Given the AUTHOR/NAME of a package on ContentDB, return a Guix-compliant
-name for the package."
- ;; The author is not included, as the names of popular mods
- ;; tend to be unique.
- (string-append "minetest-" (snake-case (author/name->name author/name))))
-
-(define (author/name->name author/name)
- "Extract NAME from the AUTHOR/NAME string, or raise an error if AUTHOR/NAME
-is ill-formatted."
- (match (string-split author/name #\/)
- ((author name)
- (when (string-null? author)
- (leave
- (G_ "In ~a: author names must consist of at least a single character.~%")
- author/name))
- (when (string-null? name)
- (leave
- (G_ "In ~a: mod names must consist of at least a single character.~%")
- author/name))
- name)
- ((too many . components)
- (leave
- (G_ "In ~a: author names and mod names may not contain forward slashes.~%")
- author/name))
- ((name)
- (if (string-null? name)
- (leave (G_ "mod names may not be empty.~%"))
- (leave (G_ "The name of the author is missing in ~a.~%")
- author/name)))))
-
-(define* (elaborate-contentdb-name name #:key (sort %default-sort-key))
- "If NAME is an AUTHOR/NAME string, return it. Otherwise, try to determine
-the author and return an appropriate AUTHOR/NAME string. If that fails,
-raise an exception."
- (if (or (string-contains name "/") (string-null? name))
- ;; Call 'author/name->name' to verify that NAME seems reasonable
- ;; and raise an appropriate exception if it isn't.
- (begin
- (author/name->name name)
- name)
- (let* ((package-keys (contentdb-query-packages name #:sort sort))
- (correctly-named
- (filter (lambda (package-key)
- (string=? name (package-keys-name package-key)))
- package-keys)))
- (match correctly-named
- ((one) (package-keys-full-name one))
- ((too . many)
- (warning (G_ "~a is ambiguous, presuming ~a (other options include: ~a)~%")
- name (package-keys-full-name too)
- (map package-keys-full-name many))
- (package-keys-full-name too))
- (()
- (leave (G_ "No mods with name ~a were found.~%") name))))))
-
-
-
-;;;
-;;; API endpoints
-;;;
-
-(define contentdb-fetch
- (mlambda (author/name)
- "Return a <package> record for package AUTHOR/NAME, or #f on failure."
- (and=> (json-fetch
- (string-append (%contentdb-api) "packages/" author/name "/"))
- json->package)))
-
-(define (contentdb-fetch-releases author/name)
- "Return a list of <release> records for package NAME by AUTHOR, or #f
-on failure."
- (and=> (json-fetch (string-append (%contentdb-api) "packages/" author/name
- "/releases/"))
- (lambda (json)
- (map json->release (vector->list json)))))
-
-(define (latest-release author/name)
- "Return the latest source release for package NAME by AUTHOR,
-or #f if this package does not exist."
- (and=> (contentdb-fetch-releases author/name)
- car))
-
-(define (contentdb-fetch-dependencies author/name)
- "Return an alist of lists of <dependency> records for package NAME by AUTHOR
-and possibly some other packages as well, or #f on failure."
- (define url (string-append (%contentdb-api) "packages/" author/name
- "/dependencies/"))
- (and=> (json-fetch url)
- (lambda (json)
- (map (match-lambda
- ((key . value)
- (cons key (map json->dependency (vector->list value)))))
- json))))
-
-(define* (contentdb-query-packages q #:key
- (type "mod")
- (limit 50)
- (sort %default-sort-key)
- (order "desc"))
- "Search ContentDB for Q (a string). Sort by SORT, in ascending order
-if ORDER is \"asc\" or descending order if ORDER is \"desc\". TYPE must
-be \"mod\", \"game\" or \"txp\", restricting the search results to
-respectively mods, games and texture packs. Limit to at most LIMIT
-results. The return value is a list of <package-keys> records."
- ;; XXX does Guile have something for constructing (and, when necessary,
- ;; escaping) query strings?
- (define url (string-append (%contentdb-api) "packages/?type=" type
- "&q=" q "&fmt=keys"
- "&limit=" (number->string limit)
- "&order=" order
- "&sort=" sort))
- (let ((json (json-fetch url)))
- (if json
- (map json->package-keys (vector->list json))
- (leave
- (G_ "The package search API doesn't exist anymore.~%")))))
-
-
-
-;; XXX copied from (guix import elpa)
-(define* (download-git-repository url ref)
- "Fetch the given REF from the Git repository at URL."
- (with-store store
- (latest-repository-commit store url #:ref ref)))
-
-(define (make-minetest-sexp author/name version repository commit
- inputs home-page synopsis
- description media-license license)
- "Return a S-expression for the minetest package with the given author/NAME,
-VERSION, REPOSITORY, COMMIT, INPUTS, HOME-PAGE, SYNOPSIS, DESCRIPTION,
-MEDIA-LICENSE and LICENSE."
- `(package
- (name ,(contentdb->package-name author/name))
- (version ,version)
- (source
- (origin
- (method git-fetch)
- (uri (git-reference
- (url ,repository)
- (commit ,commit)))
- (sha256
- (base32
- ;; The git commit is not always available.
- ,(and commit
- (bytevector->nix-base32-string
- (file-hash*
- (download-git-repository repository
- `(commit . ,commit))
- ;; 'download-git-repository' already filtered out the '.git'
- ;; directory.
- #:select? (const #true)
- #:recursive? #true)))))
- (file-name (git-file-name name version))))
- (build-system minetest-mod-build-system)
- ,@(maybe-propagated-inputs (map contentdb->package-name inputs))
- (home-page ,home-page)
- (synopsis ,(delete-cr synopsis))
- (description ,(beautify-description (delete-cr description)))
- (license ,(if (eq? media-license license)
- license
- `(list ,media-license ,license)))
- ;; The Minetest updater (not yet in Guix; it requires not-yet-submitted
- ;; patches to (guix upstream) that require some work) needs to know both
- ;; the author name and mod name for efficiency.
- (properties ,(list 'quasiquote `((upstream-name . ,author/name))))))
-
-(define (package-home-page package)
- "Guess the home page of the ContentDB package PACKAGE.
-
-In order of preference, try the 'website', the forum topic on the
-official Minetest forum and the Git repository (if any)."
- (define (topic->url-sexp topic)
- ;; 'minetest-topic' is a procedure defined in (gnu packages minetest)
- `(minetest-topic ,topic))
- (or (package-website package)
- (and=> (package-forums package) topic->url-sexp)
- (package-repository package)))
-
-(define (release-version release)
- "Guess the version of RELEASE from the release title."
- (define title (release-title release))
- (if (string-prefix? "v" title)
- ;; Remove "v" prefix from release titles like ‘v1.0.1’.
- (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")
-
-(define* (sort-packages packages #:key (sort %default-sort-key))
- "Sort PACKAGES by SORT, in descending order."
- (define package->key
- (match sort
- ("score" package-score)
- ("downloads" package-downloads)))
- (define (greater x y)
- (> (package->key x) (package->key y)))
- (sort-list packages greater))
-
-(define builtin-mod?
- (let ((%builtin-mods
- (alist->hash-table
- (map (lambda (x) (cons x #t))
- '("beds" "binoculars" "boats" "bones" "bucket" "butterflies"
- "carts" "creative" "default" "doors" "dungeon_loot" "dye"
- "env_sounds" "farming" "fire" "fireflies" "flowers"
- "game_commands" "give_initial_stuff" "map" "mtg_craftguide"
- "player_api" "screwdriver" "sethome" "sfinv" "spawn" "stairs"
- "tnt" "vessels" "walls" "weather" "wool" "xpanes")))))
- (lambda (mod)
- "Is MOD provided by the default minetest subgame?"
- (hash-ref %builtin-mods mod))))
-
-(define* (important-dependencies dependencies author/name
- #:key (sort %default-sort-key))
- "Return the hard dependencies of AUTHOR/NAME in the association list
-DEPENDENCIES as a list of AUTHOR/NAME strings."
- (define dependency-list
- (assoc-ref dependencies author/name))
- ;; A mod can have multiple dependencies implemented by the same mod,
- ;; so remove duplicate mod names.
- (define (filter-deduplicate-map f list)
- (delete-duplicates (filter-map f list)))
- (filter-deduplicate-map
- (lambda (dependency)
- (and (not (dependency-optional? dependency))
- (not (builtin-mod? (dependency-name dependency)))
- ;; The dependency information contains symbolic names
- ;; that can be ‘provided’ by multiple mods, so we need to choose one
- ;; of the implementations.
- (let* ((implementations
- (par-map contentdb-fetch (dependency-packages dependency)))
- ;; Fetching package information about the packages is racy:
- ;; some packages might be removed from ContentDB between the
- ;; construction of DEPENDENCIES and the call to
- ;; 'contentdb-fetch'. So filter out #f.
- ;;
- ;; Filter out ‘games’ that include the requested mod -- it's
- ;; the mod itself we want.
- (mods (filter (lambda (p) (and=> p package-mod?))
- implementations))
- (sorted-mods (sort-packages mods #:sort sort)))
- (match sorted-mods
- ((package) (package-full-name package))
- ((too . many)
- (warning
- (G_ "The dependency ~a of ~a has multiple different implementations ~a.~%")
- (dependency-name dependency)
- author/name
- (map package-full-name sorted-mods))
- (match sort
- ("score"
- (warning
- (G_ "The implementation with the highest score will be chosen!~%")))
- ("downloads"
- (warning
- (G_ "The implementation that has been downloaded the most will be chosen!~%"))))
- (package-full-name too))
- (()
- (warning
- (G_ "The dependency ~a of ~a does not have any implementation. It will be ignored!~%")
- (dependency-name dependency) author/name)
- #f)))))
- dependency-list))
-
-(define* (%minetest->guix-package author/name #:key (sort %default-sort-key)
- #:allow-other-keys)
- "Fetch the metadata for AUTHOR/NAME from https://content.minetest.net, and
-return the 'package' S-expression corresponding to that package, or raise an
-exception on failure. On success, also return the upstream dependencies as a
-list of AUTHOR/NAME strings."
- ;; Call 'author/name->name' to verify that AUTHOR/NAME seems reasonable.
- (author/name->name author/name)
- (define package (contentdb-fetch author/name))
- (unless package
- (leave (G_ "no package metadata for ~a on ContentDB~%") author/name))
- (define dependencies (contentdb-fetch-dependencies author/name))
- (unless dependencies
- (leave (G_ "no dependency information for ~a on ContentDB~%") author/name))
- (define release (latest-release author/name))
- (unless release
- (leave (G_ "no release of ~a on ContentDB~%") author/name))
- (define important-upstream-dependencies
- (important-dependencies dependencies author/name #:sort sort))
- (values (make-minetest-sexp author/name
- (release-version release)
- (package-repository package)
- (release-commit release)
- important-upstream-dependencies
- (package-home-page package)
- (package-short-description package)
- (package-long-description package)
- (spdx-string->license
- (package-media-license package))
- (spdx-string->license
- (package-license package)))
- important-upstream-dependencies))
-
-(define minetest->guix-package
- (memoize %minetest->guix-package))
-
-(define* (minetest-recursive-import author/name #:key (sort %default-sort-key))
- (define* (minetest->guix-package* author/name #:key version #:allow-other-keys)
- (minetest->guix-package author/name #:sort sort))
- (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 #:key version partial-version?)
- "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))
-
- (when version
- (raise
- (formatted-message
- (G_ "~a updater doesn't support updating to a specific version, sorry.")
- "minetest")))
- (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 (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?)
- (import latest-minetest-release)))
+(define-deprecated/alias minetest-package? luanti-package?)
+(define-deprecated/alias latest-minetest-release latest-luanti-release)
+(define-deprecated/alias minetest->guix-package luanti->guix-package)
+(define-deprecated/alias minetest-recursive-import luanti-recursive-import)
+(define-deprecated/alias %minetest-updater %luanti-updater)
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 0d5256a815..9db4919156 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -50,7 +50,8 @@
;; The list of all known importers. These are printed in order by SHOW-HELP, so
;; please keep this list alphabetically sorted!
(define importers '("composer" "cpan" "cran" "crate" "egg" "elm" "elpa"
- "gem" "gnu" "go" "hackage" "hexpm" "json" "minetest"
+ "gem" "gnu" "go" "hackage" "hexpm" "json" "luanti"
+ "minetest" ; deprecated
"npm-binary" "nuget" "opam" "pypi" "stackage" "texlive"))
(define (resolve-importer name)
diff --git a/guix/scripts/import/luanti.scm b/guix/scripts/import/luanti.scm
new file mode 100644
index 0000000000..51355abbbf
--- /dev/null
+++ b/guix/scripts/import/luanti.scm
@@ -0,0 +1,118 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2014 David Thompson <davet@gnu.org>
+;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
+;;;
+;;; 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 scripts import luanti)
+ #:use-module (guix ui)
+ #:use-module (guix utils)
+ #:use-module (guix scripts)
+ #:use-module (guix import luanti)
+ #:use-module (guix import utils)
+ #:use-module (guix scripts import)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-37)
+ #:use-module (ice-9 match)
+ #:use-module (ice-9 format)
+ #:export (guix-import-luanti))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+ `((sort . ,%default-sort-key)))
+
+(define (show-help)
+ (display (G_ "Usage: guix import luanti AUTHOR/NAME
+Import and convert the Luanti mod NAME by AUTHOR from ContentDB.\n"))
+ (display (G_ "
+ -h, --help display this help and exit"))
+ (display (G_ "
+ -r, --recursive import packages recursively"))
+ (display (G_ "
+ -V, --version display version information and exit"))
+ (display (G_ "
+ --sort=KEY when choosing between multiple implementations,
+ choose the one with the highest value for KEY
+ (one of \"score\" (standard) or \"downloads\")"))
+ (newline)
+ (show-bug-report-information))
+
+(define (verify-sort-order sort)
+ "Verify SORT can be used to sort mods by."
+ (unless (member sort '("score" "downloads" "reviews"))
+ (leave (G_ "~a: not a valid key to sort by~%") sort))
+ sort)
+
+(define %options
+ ;; Specification of the command-line options.
+ (cons* (option '(#\h "help") #f #f
+ (lambda args
+ (show-help)
+ (exit 0)))
+ (option '(#\V "version") #f #f
+ (lambda args
+ (show-version-and-exit "guix import luanti")))
+ (option '(#\r "recursive") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'recursive #t result)))
+ (option '("sort") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'sort (verify-sort-order arg) result)))
+ %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-luanti . args)
+ (define (parse-options)
+ ;; Return the alist of option values.
+ (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (G_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (alist-cons 'argument arg result))
+ %default-options))
+
+ (let* ((opts (parse-options))
+ (args (filter-map (match-lambda
+ (('argument . value)
+ value)
+ (_ #f))
+ (reverse opts))))
+ (match args
+ ((name)
+ (with-error-handling
+ (let* ((sort (assoc-ref opts 'sort))
+ (author/name (elaborate-contentdb-name name #:sort sort)))
+ (if (assoc-ref opts 'recursive)
+ ;; Recursive import
+ (filter-map package->definition
+ (luanti-recursive-import author/name #:sort sort))
+ ;; Single import
+ (luanti->guix-package author/name #:sort sort)))))
+ (()
+ (leave (G_ "too few arguments~%")))
+ ((many ...)
+ (leave (G_ "too many arguments~%"))))))
diff --git a/guix/scripts/import/minetest.scm b/guix/scripts/import/minetest.scm
index 5f204d90fc..2bfbbd3c02 100644
--- a/guix/scripts/import/minetest.scm
+++ b/guix/scripts/import/minetest.scm
@@ -2,6 +2,7 @@
;;; Copyright © 2014 David Thompson <davet@gnu.org>
;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
+;;; Copyright © 2025 Liliana Marie Prikler <liliana.prikler@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -19,99 +20,11 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts import minetest)
- #:use-module (guix ui)
- #:use-module (guix utils)
- #:use-module (guix scripts)
- #:use-module (guix import minetest)
- #:use-module (guix import utils)
- #:use-module (guix scripts import)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-11)
- #:use-module (srfi srfi-37)
- #:use-module (ice-9 match)
- #:use-module (ice-9 format)
+ #:use-module (guix scripts import luanti)
+ #:use-module (guix deprecation)
#:export (guix-import-minetest))
-
-;;;
-;;; Command-line options.
-;;;
-
-(define %default-options
- `((sort . ,%default-sort-key)))
-
-(define (show-help)
- (display (G_ "Usage: guix import minetest AUTHOR/NAME
-Import and convert the Minetest mod NAME by AUTHOR from ContentDB.\n"))
- (display (G_ "
- -h, --help display this help and exit"))
- (display (G_ "
- -r, --recursive import packages recursively"))
- (display (G_ "
- -V, --version display version information and exit"))
- (display (G_ "
- --sort=KEY when choosing between multiple implementations,
- choose the one with the highest value for KEY
- (one of \"score\" (standard) or \"downloads\")"))
- (newline)
- (show-bug-report-information))
-
-(define (verify-sort-order sort)
- "Verify SORT can be used to sort mods by."
- (unless (member sort '("score" "downloads" "reviews"))
- (leave (G_ "~a: not a valid key to sort by~%") sort))
- sort)
-
-(define %options
- ;; Specification of the command-line options.
- (cons* (option '(#\h "help") #f #f
- (lambda args
- (show-help)
- (exit 0)))
- (option '(#\V "version") #f #f
- (lambda args
- (show-version-and-exit "guix import minetest")))
- (option '(#\r "recursive") #f #f
- (lambda (opt name arg result)
- (alist-cons 'recursive #t result)))
- (option '("sort") #t #f
- (lambda (opt name arg result)
- (alist-cons 'sort (verify-sort-order arg) result)))
- %standard-import-options))
-
-
-;;;
-;;; Entry point.
-;;;
-
(define (guix-import-minetest . args)
- (define (parse-options)
- ;; Return the alist of option values.
- (args-fold* args %options
- (lambda (opt name arg result)
- (leave (G_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (alist-cons 'argument arg result))
- %default-options))
-
- (let* ((opts (parse-options))
- (args (filter-map (match-lambda
- (('argument . value)
- value)
- (_ #f))
- (reverse opts))))
- (match args
- ((name)
- (with-error-handling
- (let* ((sort (assoc-ref opts 'sort))
- (author/name (elaborate-contentdb-name name #:sort sort)))
- (if (assoc-ref opts 'recursive)
- ;; Recursive import
- (filter-map package->definition
- (minetest-recursive-import author/name #:sort sort))
- ;; Single import
- (minetest->guix-package author/name #:sort sort)))))
- (()
- (leave (G_ "too few arguments~%")))
- ((many ...)
- (leave (G_ "too many arguments~%"))))))
+ (warn-about-deprecation 'guix-import-minetest #f
+ #:replacement 'guix-import-luanti)
+ (apply guix-import-luanti args))