diff options
Diffstat (limited to 'guix/import/minetest.scm')
| -rw-r--r-- | guix/import/minetest.scm | 517 |
1 files changed, 19 insertions, 498 deletions
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) |