diff options
author | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2025-06-29 15:20:47 +0200 |
---|---|---|
committer | Liliana Marie Prikler <liliana.prikler@gmail.com> | 2025-07-13 13:54:01 +0200 |
commit | abbdfbb775d31c5ccc4f11abcb3650d123e28cc2 (patch) | |
tree | 2a4a13cf121e3fa71368cc3dba9281f349eab266 /guix | |
parent | 464c3b63401f213a13870146f4e592734972b54b (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.scm | 104 | ||||
-rw-r--r-- | guix/build-system/minetest.scm | 86 | ||||
-rw-r--r-- | guix/build/luanti-build-system.scm | 228 | ||||
-rw-r--r-- | guix/build/minetest-build-system.scm | 214 | ||||
-rw-r--r-- | guix/import/luanti.scm | 520 | ||||
-rw-r--r-- | guix/import/minetest.scm | 517 | ||||
-rw-r--r-- | guix/scripts/import.scm | 3 | ||||
-rw-r--r-- | guix/scripts/import/luanti.scm | 118 | ||||
-rw-r--r-- | guix/scripts/import/minetest.scm | 99 |
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)) |