From 613a9c7cb3419d2301cd4748cd0db90e880278c5 Mon Sep 17 00:00:00 2001 From: Brice Waegeneire Date: Wed, 4 Aug 2021 16:59:40 +0200 Subject: import: gem: Fix typo. * guix/scripts/import/gem.scm (%options): Fix typo. --- guix/scripts/import/gem.scm | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'guix/scripts/import') diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index 65d2bf10b4..328d20b946 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2015 David Thompson ;;; Copyright © 2018 Oleg Pykhalov ;;; Copyright © 2021 Sarah Morgensen +;;; Copyright © 2021 Brice Waegeneire ;;; ;;; This file is part of GNU Guix. ;;; @@ -60,7 +61,7 @@ Import and convert the RubyGems package for PACKAGE-NAME.\n")) (exit 0))) (option '(#\V "version") #f #f (lambda args - (show-version-and-exit "guix import pypi"))) + (show-version-and-exit "guix import gem"))) (option '(#\r "recursive") #f #f (lambda (opt name arg result) (alist-cons 'recursive #t result))) -- cgit v1.2.3 From 467e874a86dc3dd83fe10e5610823c011de6565a Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Tue, 10 Aug 2021 17:07:20 +0200 Subject: guix: Add ContentDB importer. * guix/import/contentdb.scm: New file. * guix/scripts/import/contentdb.scm: New file. * tests/contentdb.scm: New file. * Makefile.am (MODULES, SCM_TESTS): Register them. * po/guix/POTFILES.in: Likewise. * doc/guix.texi (Invoking guix import): Document it. Signed-off-by: Leo Prikler --- Makefile.am | 3 + doc/guix.texi | 32 +++ guix/import/minetest.scm | 456 +++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 3 +- guix/scripts/import/minetest.scm | 117 ++++++++++ po/guix/POTFILES.in | 1 + tests/minetest.scm | 355 ++++++++++++++++++++++++++++++ 7 files changed, 966 insertions(+), 1 deletion(-) create mode 100644 guix/import/minetest.scm create mode 100644 guix/scripts/import/minetest.scm create mode 100644 tests/minetest.scm (limited to 'guix/scripts/import') diff --git a/Makefile.am b/Makefile.am index 344b7423c5..327d3f9961 100644 --- a/Makefile.am +++ b/Makefile.am @@ -262,6 +262,7 @@ MODULES = \ guix/import/json.scm \ guix/import/kde.scm \ guix/import/launchpad.scm \ + guix/import/minetest.scm \ guix/import/opam.scm \ guix/import/print.scm \ guix/import/pypi.scm \ @@ -304,6 +305,7 @@ MODULES = \ guix/scripts/import/go.scm \ guix/scripts/import/hackage.scm \ guix/scripts/import/json.scm \ + guix/scripts/import/minetest.scm \ guix/scripts/import/opam.scm \ guix/scripts/import/pypi.scm \ guix/scripts/import/stackage.scm \ @@ -470,6 +472,7 @@ SCM_TESTS = \ tests/import-utils.scm \ tests/inferior.scm \ tests/lint.scm \ + tests/minetest.scm \ tests/modules.scm \ tests/monads.scm \ tests/nar.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index d6197d3743..241a1824ec 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11314,6 +11314,38 @@ and generate package expressions for all those packages that are not yet in Guix. @end table +@item contentdb +@cindex minetest +@cindex ContentDB +Import metadata from @uref{https://content.minetest.net, ContentDB}. +Information is taken from the JSON-formatted metadata provided through +@uref{https://content.minetest.net/help/api/, ContentDB's API} and +includes most relevant information, including dependencies. There are +some caveats, however. The license information is often incomplete. +The commit hash is sometimes missing. The descriptions are in the +Markdown format, but Guix uses Texinfo instead. Texture packs and +subgames are unsupported. + +The command below imports metadata for the Mesecons mod by Jeija: + +@example +guix import minetest Jeija/mesecons +@end example + +The author name can also be left out: + +@example +guix import minetest mesecons +@end example + +@table @code +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. +@end table + @item cpan @cindex CPAN Import metadata from @uref{https://www.metacpan.org/, MetaCPAN}. diff --git a/guix/import/minetest.scm b/guix/import/minetest.scm new file mode 100644 index 0000000000..e1f8487b75 --- /dev/null +++ b/guix/import/minetest.scm @@ -0,0 +1,456 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Maxime Devos +;;; +;;; 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 . + +(define-module (guix import minetest) + #:use-module (ice-9 match) + #:use-module (ice-9 receive) + #:use-module (ice-9 threads) + #:use-module (ice-9 hash-table) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-2) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module (guix utils) + #:use-module (guix ui) + #:use-module (guix i18n) + #:use-module (guix memoization) + #:use-module (guix serialization) + #:use-module (guix import utils) + #:use-module (guix import json) + #:use-module ((gcrypt hash) #:select (open-sha256-port port-sha256)) + #:use-module (json) + #:use-module (guix base32) + #:use-module (guix git) + #:use-module (guix store) + #:export (%default-sort-key + %contentdb-api + json->package + contentdb-fetch + elaborate-contentdb-name + minetest->guix-package + minetest-recursive-import + sort-packages)) + +;; The ContentDB API is documented at +;; . + +(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 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 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 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 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 object, return the corresponding AUTHOR/NAME string." + (%construct-full-name (package-author package) (package-name package))) + +(define (package-keys-full-name package) + "Given a 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 ambigious, 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 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 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 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 thes search results to +respectively mods, games and texture packs. Limit to at most LIMIT +results. The return value is a list of 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))) + +;; XXX adapted from (guix scripts hash) +(define (file-hash file) + "Compute the hash of FILE." + (let-values (((port get-hash) (open-sha256-port))) + (write-file file port) + (force-output port) + (get-hash))) + +(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))))))) + (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 ,(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))) + +;; 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)) + (filter-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 choosen!~%"))) + ("downloads" + (warning + (G_ "The implementation that has been downloaded the most will be choosen!~%")))) + (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)) + "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-title release) ; version + (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 repo version) + (minetest->guix-package author/name #:sort sort)) + (recursive-import author/name + #:repo->guix-package minetest->guix-package* + #:guix-name contentdb->package-name)) diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index f53d1ac1f4..b369a362d0 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -77,7 +77,8 @@ rather than \\n." ;;; (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" - "gem" "go" "cran" "crate" "texlive" "json" "opam")) + "gem" "go" "cran" "crate" "texlive" "json" "opam" + "minetest")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/minetest.scm b/guix/scripts/import/minetest.scm new file mode 100644 index 0000000000..5f204d90fc --- /dev/null +++ b/guix/scripts/import/minetest.scm @@ -0,0 +1,117 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2014 David Thompson +;;; Copyright © 2018 Ricardo Wurmus +;;; Copyright © 2021 Maxime Devos +;;; +;;; 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 . + +(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) + #: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~%")))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 14324b25de..1eee82be53 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -60,6 +60,7 @@ guix/scripts/git.scm guix/scripts/git/authenticate.scm guix/scripts/hash.scm guix/scripts/import.scm +guix/scripts/import/contentdb.scm guix/scripts/import/cran.scm guix/scripts/import/elpa.scm guix/scripts/pull.scm diff --git a/tests/minetest.scm b/tests/minetest.scm new file mode 100644 index 0000000000..6ae476fe5f --- /dev/null +++ b/tests/minetest.scm @@ -0,0 +1,355 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Maxime Devos +;;; +;;; 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 . + +(define-module (test-minetest) + #:use-module (guix memoization) + #:use-module (guix import minetest) + #:use-module (guix import utils) + #:use-module (guix tests) + #:use-module (json) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-34) + #:use-module (srfi srfi-64)) + + +;; Some procedures for populating a ‘fake’ ContentDB server. + +(define* (make-package-sexp #:key + (guix-name "minetest-foo") + (home-page "https://example.org/foo") + (repo "https://example.org/foo.git") + (synopsis "synopsis") + (guix-description "description") + (guix-license + '(list license:cc-by-sa4.0 license:lgpl3+)) + (inputs '()) + (upstream-name "Author/foo") + #:allow-other-keys) + `(package + (name ,guix-name) + ;; This is not a proper version number but ContentDB does not include + ;; version numbers. + (version "2021-07-25") + (source + (origin + (method git-fetch) + (uri (git-reference + (url ,(and (not (eq? repo 'null)) repo)) + (commit #f))) + (sha256 + (base32 #f)) + (file-name (git-file-name name version)))) + (build-system minetest-mod-build-system) + ,@(maybe-propagated-inputs inputs) + (home-page ,home-page) + (synopsis ,synopsis) + (description ,guix-description) + (license ,guix-license) + (properties + ,(list 'quasiquote + `((upstream-name . ,upstream-name)))))) + +(define* (make-package-json #:key + (author "Author") + (name "foo") + (media-license "CC-BY-SA-4.0") + (license "LGPL-3.0-or-later") + (short-description "synopsis") + (long-description "description") + (repo "https://example.org/foo.git") + (website "https://example.org/foo") + (forums 321) + (score 987.654) + (downloads 123) + (type "mod") + #:allow-other-keys) + `(("author" . ,author) + ("content_warnings" . #()) + ("created_at" . "2018-05-23T19:58:07.422108") + ("downloads" . ,downloads) + ("forums" . ,forums) + ("issue_tracker" . "https://example.org/foo/issues") + ("license" . ,license) + ("long_description" . ,long-description) + ("maintainers" . #("maintainer")) + ("media_license" . ,media-license) + ("name" . ,name) + ("provides" . #("stuff")) + ("release" . 456) + ("repo" . ,repo) + ("score" . ,score) + ("screenshots" . #()) + ("short_description" . ,short-description) + ("state" . "APPROVED") + ("tags" . #("some" "tags")) + ("thumbnail" . null) + ("title" . "The name") + ("type" . ,type) + ("url" . ,(string-append "https://content.minetest.net/packages/" + author "/" name "/download/")) + ("website" . ,website))) + +(define* (make-releases-json #:key (commit #f) (title "") #:allow-other-keys) + `#((("commit" . ,commit) + ("downloads" . 469) + ("id" . 8614) + ("max_minetest_version" . null) + ("min_minetest_version" . null) + ("release_date" . "2021-07-25T01:10:23.207584") + ("title" . "2021-07-25")))) + +(define* (make-dependencies-json #:key (author "Author") + (name "foo") + (requirements '(("default" #f ()))) + #:allow-other-keys) + `((,(string-append author "/" name) + . ,(list->vector + (map (match-lambda + ((symbolic-name optional? implementations) + `(("is_optional" . ,optional?) + ("name" . ,symbolic-name) + ("packages" . ,(list->vector implementations))))) + requirements))) + ("something/else" . #()))) + +(define* (make-packages-keys-json #:key (author "Author") + (name "Name") + (type "mod")) + `(("author" . ,author) + ("name" . ,name) + ("type" . ,type))) + +(define (call-with-packages thunk . argument-lists) + ;; Don't reuse results from previous tests. + (invalidate-memoization! contentdb-fetch) + (invalidate-memoization! minetest->guix-package) + (define (scm->json-port scm) + (open-input-string (scm->json-string scm))) + (define (handle-package url requested-author requested-name . rest) + (define relevant-argument-list + (any (lambda (argument-list) + (apply (lambda* (#:key (author "Author") (name "foo") + #:allow-other-keys) + (and (equal? requested-author author) + (equal? requested-name name) + argument-list)) + argument-list)) + argument-lists)) + (when (not relevant-argument-list) + (error "the package ~a/~a should be irrelevant, but ~a is fetched" + requested-author requested-name url)) + (scm->json-port + (apply (match rest + (("") make-package-json) + (("dependencies" "") make-dependencies-json) + (("releases" "") make-releases-json) + (_ (error "TODO ~a" rest))) + relevant-argument-list))) + (define (handle-mod-search sort) + ;; Produce search results, sorted by SORT in descending order. + (define arguments->key + (match sort + ("score" (lambda* (#:key (score 987.654) #:allow-other-keys) + score)) + ("downloads" (lambda* (#:key (downloads 123) #:allow-other-keys) + downloads)))) + (define argument-list->key (cut apply arguments->key <>)) + (define (greater x y) + (> (argument-list->key x) (argument-list->key y))) + (define sorted-argument-lists (sort-list argument-lists greater)) + (define* (arguments->json #:key (author "Author") (name "Foo") (type "mod") + #:allow-other-keys) + (and (string=? type "mod") + `(("author" . ,author) + ("name" . ,name) + ("type" . ,type)))) + (define argument-list->json (cut apply arguments->json <>)) + (scm->json-port + (list->vector (filter-map argument-list->json sorted-argument-lists)))) + (mock ((guix http-client) http-fetch + (lambda* (url #:key headers) + (unless (string-prefix? "mock://api/packages/" url) + (error "the URL ~a should not be used" url)) + (define resource + (substring url (string-length "mock://api/packages/"))) + (define components (string-split resource #\/)) + (match components + ((author name . rest) + (apply handle-package url author name rest)) + (((? (cut string-prefix? "?type=mod&q=" <>) query)) + (handle-mod-search + (cond ((string-contains query "sort=score") "score") + ((string-contains query "sort=downloads") "downloads") + (#t (error "search query ~a has unknown sort key" + query))))) + (_ + (error "the URL ~a should have an author and name component" + url))))) + (parameterize ((%contentdb-api "mock://api/")) + (thunk)))) + +(define* (minetest->guix-package* #:key (author "Author") (name "foo") + (sort %default-sort-key) + #:allow-other-keys) + (minetest->guix-package (string-append author "/" name) #:sort sort)) + +(define (imported-package-sexp* primary-arguments . secondary-arguments) + "Ask the importer to import a package specified by PRIMARY-ARGUMENTS, +during a dynamic where that package and the packages specified by +SECONDARY-ARGUMENTS are available on ContentDB." + (apply call-with-packages + (lambda () + ;; The memoization cache is reset by call-with-packages + (apply minetest->guix-package* primary-arguments)) + primary-arguments + secondary-arguments)) + +(define (imported-package-sexp . extra-arguments) + "Ask the importer to import a package specified by EXTRA-ARGUMENTS, +during a dynamic extent where that package is available on ContentDB." + (imported-package-sexp* extra-arguments)) + +(define-syntax-rule (test-package test-case . extra-arguments) + (test-equal test-case + (make-package-sexp . extra-arguments) + (imported-package-sexp . extra-arguments))) + +(define-syntax-rule (test-package* test-case primary-arguments extra-arguments + ...) + (test-equal test-case + (apply make-package-sexp primary-arguments) + (imported-package-sexp* primary-arguments extra-arguments ...))) + +(test-begin "minetest") + + +;; Package names +(test-package "minetest->guix-package") +(test-package "minetest->guix-package, _ → - in package name" + #:name "foo_bar" + #:guix-name "minetest-foo-bar" + #:upstream-name "Author/foo_bar") + +(test-equal "elaborate names, unambigious" + "Jeija/mesecons" + (call-with-packages + (cut elaborate-contentdb-name "mesecons") + '(#:name "mesecons" #:author "Jeija") + '(#:name "something" #:author "else"))) + +(test-equal "elaborate name, ambigious (highest score)" + "Jeija/mesecons" + (call-with-packages + ;; #:sort "score" is the default + (cut elaborate-contentdb-name "mesecons") + '(#:name "mesecons" #:author "Jeijc" #:score 777) + '(#:name "mesecons" #:author "Jeijb" #:score 888) + '(#:name "mesecons" #:author "Jeija" #:score 999))) + + +(test-equal "elaborate name, ambigious (most downloads)" + "Jeija/mesecons" + (call-with-packages + (cut elaborate-contentdb-name "mesecons" #:sort "downloads") + '(#:name "mesecons" #:author "Jeijc" #:downloads 777) + '(#:name "mesecons" #:author "Jeijb" #:downloads 888) + '(#:name "mesecons" #:author "Jeija" #:downloads 999))) + + +;; Determining the home page +(test-package "minetest->guix-package, website is used as home page" + #:home-page "web://site" + #:website "web://site") +(test-package "minetest->guix-package, if absent, the forum is used" + #:home-page '(minetest-topic 628) + #:forums 628 + #:website 'null) +(test-package "minetest->guix-package, if absent, the git repo is used" + #:home-page "https://github.com/minetest-mods/mesecons" + #:forums 'null + #:website 'null + #:repo "https://github.com/minetest-mods/mesecons") +(test-package "minetest->guix-package, all home page information absent" + #:home-page #f + #:forums 'null + #:website 'null + #:repo 'null) + + + +;; Dependencies +(test-package* "minetest->guix-package, unambigious dependency" + (list #:requirements '(("mesecons" #f + ("Jeija/mesecons" + "some-modpack/containing-mese"))) + #:inputs '("minetest-mesecons")) + (list #:author "Jeija" #:name "mesecons") + (list #:author "some-modpack" #:name "containing-mese" #:type "modpack")) + +(test-package* "minetest->guix-package, ambigious dependency (highest score)" + (list #:name "frobnicate" + #:guix-name "minetest-frobnicate" + #:upstream-name "Author/frobnicate" + #:requirements '(("frob" #f + ("Author/foo" "Author/bar"))) + ;; #:sort "score" is the default + #:inputs '("minetest-bar")) + (list #:author "Author" #:name "foo" #:score 0) + (list #:author "Author" #:name "bar" #:score 9999)) + +(test-package* "minetest->guix-package, ambigious dependency (most downloads)" + (list #:name "frobnicate" + #:guix-name "minetest-frobnicate" + #:upstream-name "Author/frobnicate" + #:requirements '(("frob" #f + ("Author/foo" "Author/bar"))) + #:inputs '("minetest-bar") + #:sort "downloads") + (list #:author "Author" #:name "foo" #:downloads 0) + (list #:author "Author" #:name "bar" #:downloads 9999)) + +(test-package "minetest->guix-package, optional dependency" + #:requirements '(("mesecons" #t + ("Jeija/mesecons" + "some-modpack/containing-mese"))) + #:inputs '()) + + +;; License +(test-package "minetest->guix-package, identical licenses" + #:guix-license 'license:lgpl3+ + #:license "LGPL-3.0-or-later" + #:media-license "LGPL-3.0-or-later") + +;; Sorting +(let* ((make-package + (lambda arguments + (json->package (apply make-package-json arguments)))) + (x (make-package #:score 0)) + (y (make-package #:score 1)) + (z (make-package #:score 2))) + (test-equal "sort-packages, already sorted" + (list z y x) + (sort-packages (list z y x))) + (test-equal "sort-packages, reverse" + (list z y x) + (sort-packages (list x y z)))) + +(test-end "minetest") -- cgit v1.2.3 From fc29c80b9635ff490bcc768c774442043cb1e231 Mon Sep 17 00:00:00 2001 From: Alice BRENON Date: Sat, 7 Aug 2021 19:50:10 +0200 Subject: guix: opam: More flexibility in the importer. * guix/scripts/import/opam.scm: Pass all instances of --repo as a list to the importer. * guix/import/opam.scm (opam-fetch): Stop expecting "expanded" repositories and call get-opam-repository instead to keep values "symbolic" as long as possible and factorize. (get-opam-repository): Use the same repository source as CLI opam does (i.e. HTTP-served index.tar.gz instead of git repositories). (find-latest-version): Be more flexible on the repositories structure instead of expecting packages/PACKAGE-NAME/PACKAGE-NAME.VERSION/. * tests/opam.scm: Update the call to opam->guix-package since repo is now expected to be a list and remove the mocked get-opam-repository deprecated by the support for local folders by the actual implementation. * doc/guix.texi: Document the new semantics and valid arguments for the --repo option. Signed-off-by: Julien Lepiller --- doc/guix.texi | 29 ++++++-- guix/import/opam.scm | 158 ++++++++++++++++++++++++++----------------- guix/scripts/import/opam.scm | 8 ++- tests/opam.scm | 68 +++++++++---------- 4 files changed, 159 insertions(+), 104 deletions(-) (limited to 'guix/scripts/import') diff --git a/doc/guix.texi b/doc/guix.texi index 949d6d4092..5155e67481 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -95,6 +95,7 @@ Copyright @copyright{} 2021 Raghav Gururajan@* Copyright @copyright{} 2021 Domagoj Stolfa@* Copyright @copyright{} 2021 Hui Lu@* Copyright @copyright{} 2021 pukkamustard@* +Copyright @copyright{} 2021 Alice Brenon@* Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -11659,14 +11660,30 @@ Traverse the dependency graph of the given upstream package recursively and generate package expressions for all those packages that are not yet in Guix. @item --repo -Select the given repository (a repository name). Possible values include: +By default, packages are searched in the official OPAM repository. This +option, which can be used more than once, lets you add other repositories +which will be searched for packages. It accepts as valid arguments: + @itemize -@item @code{opam}, the default opam repository, -@item @code{coq} or @code{coq-released}, the stable repository for coq packages, -@item @code{coq-core-dev}, the repository that contains development versions of coq, -@item @code{coq-extra-dev}, the repository that contains development versions - of coq packages. +@item the name of a known repository - can be one of @code{opam}, + @code{coq} (equivalent to @code{coq-released}), + @code{coq-core-dev}, @code{coq-extra-dev} or @code{grew}. +@item the URL of a repository as expected by the @code{opam repository + add} command (for instance, the URL equivalent of the above + @code{opam} name would be @uref{https://opam.ocaml.org}). +@item the path to a local copy of a repository (a directory containing a + @file{packages/} sub-directory). @end itemize + +Repositories are assumed to be passed to this option by order of +preference. The additional repositories will not replace the default +@code{opam} repository, which is always kept as a fallback. + +Also, please note that versions are not compared accross repositories. +The first repository (from left to right) that has at least one version +of a given package will prevail over any others, and the version +imported will be the latest one found @emph{in this repository only}. + @end table @item go diff --git a/guix/import/opam.scm b/guix/import/opam.scm index a35b01d277..fe13d29f03 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2020 Martin Becze ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Alice Brenon ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,21 +23,24 @@ #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 peg) + #:use-module ((ice-9 popen) #:select (open-pipe*)) #:use-module (ice-9 receive) - #:use-module ((ice-9 rdelim) #:select (read-line)) #:use-module (ice-9 textual-ports) #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-2) - #:use-module (web uri) + #:use-module ((srfi srfi-26) #:select (cut)) + #:use-module ((web uri) #:select (string->uri uri->string)) + #:use-module ((guix build utils) #:select (dump-port find-files mkdir-p)) #:use-module (guix build-system) #:use-module (guix build-system ocaml) #:use-module (guix http-client) - #:use-module (guix git) #:use-module (guix ui) #:use-module (guix packages) #:use-module (guix upstream) - #:use-module (guix utils) + #:use-module ((guix utils) #:select (cache-directory + version>? + call-with-temporary-output-file)) #:use-module (guix import utils) #:use-module ((guix licenses) #:prefix license:) #:export (opam->guix-package @@ -121,51 +125,83 @@ (define-peg-pattern condition-string all (and QUOTE (* STRCHR) QUOTE)) (define-peg-pattern condition-var all (+ (or (range #\a #\z) "-" ":"))) -(define* (get-opam-repository #:optional repo) +(define (opam-cache-directory path) + (string-append (cache-directory) "/opam/" path)) + +(define known-repositories + '((opam . "https://opam.ocaml.org") + (coq . "https://coq.inria.fr/opam/released") + (coq-released . "https://coq.inria.fr/opam/released") + (coq-core-dev . "https://coq.inria.fr/opam/core-dev") + (coq-extra-dev . "https://coq.inria.fr/opam/extra-dev") + (grew . "http://opam.grew.fr"))) + +(define (get-uri repo-root) + (let ((archive-file (string-append repo-root "/index.tar.gz"))) + (or (string->uri archive-file) + (begin + (warning (G_ "'~a' is not a valid URI~%") archive-file) + 'bad-repo)))) + +(define (repo-type repo) + (match (assoc-ref known-repositories (string->symbol repo)) + (#f (if (file-exists? repo) + `(local ,repo) + `(remote ,(get-uri repo)))) + (url `(remote ,(get-uri url))))) + +(define (update-repository input) + "Make sure the cache for opam repository INPUT is up-to-date" + (let* ((output (opam-cache-directory (basename (port-filename input)))) + (cached-date (if (file-exists? output) + (stat:mtime (stat output)) + (begin (mkdir-p output) 0)))) + (when (> (stat:mtime (stat input)) cached-date) + (call-with-port + (open-pipe* OPEN_WRITE "tar" "xz" "-C" output "-f" "-") + (cut dump-port input <>))) + output)) + +(define* (get-opam-repository #:optional (repo "opam")) "Update or fetch the latest version of the opam repository and return the path to the repository." - (let ((url (cond - ((or (not repo) (equal? repo 'opam)) - "https://github.com/ocaml/opam-repository") - ((string-prefix? "coq-" (symbol->string repo)) - "https://github.com/coq/opam-coq-archive") - ((equal? repo 'coq) "https://github.com/coq/opam-coq-archive") - (else (throw 'unknown-repository repo))))) - (receive (location commit _) - (update-cached-checkout url) - (cond - ((or (not repo) (equal? repo 'opam)) - location) - ((equal? repo 'coq) - (string-append location "/released")) - ((string-prefix? "coq-" (symbol->string repo)) - (string-append location "/" (substring (symbol->string repo) 4))) - (else location))))) + (match (repo-type repo) + (('local p) p) + (('remote 'bad-repo) #f) ; to weed it out during filter-map in opam-fetch + (('remote r) (call-with-port (http-fetch/cached r) update-repository)))) ;; Prevent Guile 3 from inlining this procedure so we can mock it in tests. (set! get-opam-repository get-opam-repository) -(define (latest-version versions) - "Find the most recent version from a list of versions." - (fold (lambda (a b) (if (version>? a b) a b)) (car versions) versions)) +(define (get-version-and-file path) + "Analyse a candidate path and return an list containing information for proper + version comparison as well as the source path for metadata." + (and-let* ((metadata-file (string-append path "/opam")) + (filename (basename path)) + (version (string-join (cdr (string-split filename #\.)) "."))) + (and (file-exists? metadata-file) + (eq? 'regular (stat:type (stat metadata-file))) + (if (string-prefix? "v" version) + `(V ,(substring version 1) ,metadata-file) + `(digits ,version ,metadata-file))))) + +(define (keep-max-version a b) + "Version comparison on the lists returned by the previous function taking the + janestreet re-versioning into account (v-prefixed come first)." + (match (cons a b) + ((('V va _) . ('V vb _)) (if (version>? va vb) a b)) + ((('V _ _) . _) a) + ((_ . ('V _ _)) b) + ((('digits va _) . ('digits vb _)) (if (version>? va vb) a b)))) (define (find-latest-version package repository) "Get the latest version of a package as described in the given repository." - (let* ((dir (string-append repository "/packages/" package)) - (versions (scandir dir (lambda (name) (not (string-prefix? "." name)))))) - (if versions - (let ((versions (map - (lambda (dir) - (string-join (cdr (string-split dir #\.)) ".")) - versions))) - ;; Workaround for janestreet re-versionning - (let ((v-versions (filter (lambda (version) (string-prefix? "v" version)) versions))) - (if (null? v-versions) - (latest-version versions) - (string-append "v" (latest-version (map (lambda (version) (substring version 1)) v-versions)))))) - (begin - (format #t (G_ "Package not found in opam repository: ~a~%") package) - #f)))) + (let ((packages (string-append repository "/packages")) + (filter (make-regexp (string-append "^" package "\\.")))) + (reduce keep-max-version #f + (filter-map + get-version-and-file + (find-files packages filter #:directories? #t))))) (define (get-metadata opam-file) (with-input-from-file opam-file @@ -266,28 +302,30 @@ path to the repository." (define (depends->native-inputs depends) (filter (lambda (name) (not (equal? "" name))) - (map dependency->native-input depends))) + (map dependency->native-input depends))) (define (dependency-list->inputs lst) (map - (lambda (dependency) - (list dependency (list 'unquote (string->symbol dependency)))) - (ocaml-names->guix-names lst))) - -(define* (opam-fetch name #:optional (repository (get-opam-repository))) - (and-let* ((repository repository) - (version (find-latest-version name repository)) - (file (string-append repository "/packages/" name "/" name "." version "/opam"))) - `(("metadata" ,@(get-metadata file)) - ("version" . ,(if (string-prefix? "v" version) - (substring version 1) - version))))) - -(define* (opam->guix-package name #:key (repo 'opam) version) - "Import OPAM package NAME from REPOSITORY (a directory name) or, if -REPOSITORY is #f, from the official OPAM repository. Return a 'package' sexp + (lambda (dependency) + (list dependency (list 'unquote (string->symbol dependency)))) + (ocaml-names->guix-names lst))) + +(define* (opam-fetch name #:optional (repositories-specs '("opam"))) + (or (fold (lambda (repository others) + (match (find-latest-version name repository) + ((_ version file) `(("metadata" ,@(get-metadata file)) + ("version" . ,version))) + (_ others))) + #f + (filter-map get-opam-repository repositories-specs)) + (leave (G_ "package '~a' not found~%") name))) + +(define* (opam->guix-package name #:key (repo '()) version) + "Import OPAM package NAME from REPOSITORIES (a list of names, URLs or local +paths, always including OPAM's official repository). Return a 'package' sexp or #f on failure." - (and-let* ((opam-file (opam-fetch name (get-opam-repository repo))) + (and-let* ((with-opam (if (member "opam" repo) repo (cons "opam" repo))) + (opam-file (opam-fetch name with-opam)) (version (assoc-ref opam-file "version")) (opam-content (assoc-ref opam-file "metadata")) (url-dict (metadata-ref opam-content "url")) @@ -312,9 +350,7 @@ or #f on failure." (values `(package (name ,(ocaml-name->guix-name name)) - (version ,(if (string-prefix? "v" version) - (substring version 1) - version)) + (version ,version) (source (origin (method url-fetch) diff --git a/guix/scripts/import/opam.scm b/guix/scripts/import/opam.scm index 64164e7cc4..834ac34cb0 100644 --- a/guix/scripts/import/opam.scm +++ b/guix/scripts/import/opam.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2021 Sarah Morgensen +;;; Copyright © 2021 Alice Brenon ;;; ;;; This file is part of GNU Guix. ;;; @@ -46,7 +47,8 @@ Import and convert the opam package for PACKAGE-NAME.\n")) (display (G_ " -r, --recursive import packages recursively")) (display (G_ " - --repo import packages from this opam repository")) + --repo import packages from this opam repository (name, URL or local path) + can be used more than once")) (display (G_ " -V, --version display version information and exit")) (newline) @@ -81,7 +83,9 @@ Import and convert the opam package for PACKAGE-NAME.\n")) #:build-options? #f)) (let* ((opts (parse-options)) - (repo (and=> (assoc-ref opts 'repo) string->symbol)) + (repo (filter-map (match-lambda + (('repo . name) name) + (_ #f)) opts)) (args (filter-map (match-lambda (('argument . value) value) diff --git a/tests/opam.scm b/tests/opam.scm index f1e3b70cb0..1536b74339 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -82,41 +82,39 @@ url { (set! test-source-hash (call-with-input-file file-name port-sha256)))) (_ (error "Unexpected URL: " url))))) - (mock ((guix import opam) get-opam-repository - (const test-repo)) - (let ((my-package (string-append test-repo - "/packages/foo/foo.1.0.0"))) - (mkdir-p my-package) - (with-output-to-file (string-append my-package "/opam") - (lambda _ - (format #t "~a" test-opam-file)))) - (match (opam->guix-package "foo" #:repo test-repo) - (('package - ('name "ocaml-foo") - ('version "1.0.0") - ('source ('origin - ('method 'url-fetch) - ('uri "https://example.org/foo-1.0.0.tar.gz") - ('sha256 - ('base32 - (? string? hash))))) - ('build-system 'ocaml-build-system) - ('propagated-inputs - ('quasiquote - (("ocaml-zarith" ('unquote 'ocaml-zarith))))) - ('native-inputs - ('quasiquote - (("ocaml-alcotest" ('unquote 'ocaml-alcotest)) - ("ocamlbuild" ('unquote 'ocamlbuild))))) - ('home-page "https://example.org/") - ('synopsis "Some example package") - ('description "This package is just an example.") - ('license 'license:bsd-3)) - (string=? (bytevector->nix-base32-string - test-source-hash) - hash)) - (x - (pk 'fail x #f)))))) + (let ((my-package (string-append test-repo + "/packages/foo/foo.1.0.0"))) + (mkdir-p my-package) + (with-output-to-file (string-append my-package "/opam") + (lambda _ + (format #t "~a" test-opam-file)))) + (match (opam->guix-package "foo" #:repo (list test-repo)) + (('package + ('name "ocaml-foo") + ('version "1.0.0") + ('source ('origin + ('method 'url-fetch) + ('uri "https://example.org/foo-1.0.0.tar.gz") + ('sha256 + ('base32 + (? string? hash))))) + ('build-system 'ocaml-build-system) + ('propagated-inputs + ('quasiquote + (("ocaml-zarith" ('unquote 'ocaml-zarith))))) + ('native-inputs + ('quasiquote + (("ocaml-alcotest" ('unquote 'ocaml-alcotest)) + ("ocamlbuild" ('unquote 'ocamlbuild))))) + ('home-page "https://example.org/") + ('synopsis "Some example package") + ('description "This package is just an example.") + ('license 'license:bsd-3)) + (string=? (bytevector->nix-base32-string + test-source-hash) + hash)) + (x + (pk 'fail x #f))))) ;; Test the opam file parser ;; We fold over some test cases. Each case is a pair of the string to parse and the -- cgit v1.2.3 From be13e2be08feb88d868f911d8f55b0451fe15e10 Mon Sep 17 00:00:00 2001 From: zimoun Date: Fri, 6 Aug 2021 11:05:17 -0700 Subject: import: go: Improve error handling. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/go.scm (go-module->guix-package*): Handle errors, remove memoize. (go-module-recursive-import): Remove 'guard', add memoize. * guix/scripts/import/go.scm (guix-import-go): Adjust. * tests/go.scm: Adjust. Signed-off-by: Ludovic Courtès --- guix/import/go.scm | 50 ++++++++++++++++++++++++++++------------------ guix/scripts/import/go.scm | 6 +++--- tests/go.scm | 2 +- 3 files changed, 35 insertions(+), 23 deletions(-) (limited to 'guix/scripts/import') diff --git a/guix/import/go.scm b/guix/import/go.scm index a4775f973f..4755571209 100644 --- a/guix/import/go.scm +++ b/guix/import/go.scm @@ -6,6 +6,7 @@ ;;; Copyright © 2021 Ludovic Courtès ;;; Copyright © 2021 Xinglu Chen ;;; Copyright © 2021 Sarah Morgensen +;;; Copyright © 2021 Simon Tournier ;;; ;;; This file is part of GNU Guix. ;;; @@ -63,6 +64,7 @@ #:use-module (web uri) #:export (go-module->guix-package + go-module->guix-package* go-module-recursive-import)) ;;; Commentary: @@ -646,7 +648,28 @@ hint: use one of the following available versions ~a\n" dependencies+versions dependencies)))) -(define go-module->guix-package* (memoize go-module->guix-package)) +(define go-module->guix-package* + (lambda args + ;; Disable output buffering so that the following warning gets printed + ;; consistently. + (setvbuf (current-error-port) 'none) + (let ((package-name (match args ((name _ ...) name)))) + (guard (c ((http-get-error? c) + (warning (G_ "Failed to import package ~s. +reason: ~s could not be fetched: HTTP error ~a (~s). +This package and its dependencies won't be imported.~%") + package-name + (uri->string (http-get-error-uri c)) + (http-get-error-code c) + (http-get-error-reason c)) + (values #f '())) + (else + (warning (G_ "Failed to import package ~s. +reason: ~s.~%") + package-name + (exception-args c)) + (values #f '()))) + (apply go-module->guix-package args))))) (define* (go-module-recursive-import package-name #:key (goproxy "https://proxy.golang.org") @@ -656,23 +679,12 @@ hint: use one of the following available versions ~a\n" (recursive-import package-name #:repo->guix-package - (lambda* (name #:key version repo) - ;; Disable output buffering so that the following warning gets printed - ;; consistently. - (setvbuf (current-error-port) 'none) - (guard (c ((http-get-error? c) - (warning (G_ "Failed to import package ~s. -reason: ~s could not be fetched: HTTP error ~a (~s). -This package and its dependencies won't be imported.~%") - name - (uri->string (http-get-error-uri c)) - (http-get-error-code c) - (http-get-error-reason c)) - (values #f '()))) - (receive (package-sexp dependencies) - (go-module->guix-package* name #:goproxy goproxy - #:version version - #:pin-versions? pin-versions?) - (values package-sexp dependencies)))) + (memoize + (lambda* (name #:key version repo) + (receive (package-sexp dependencies) + (go-module->guix-package* name #:goproxy goproxy + #:version version + #:pin-versions? pin-versions?) + (values package-sexp dependencies)))) #:guix-name go-module->guix-package-name #:version version)) diff --git a/guix/scripts/import/go.scm b/guix/scripts/import/go.scm index e08a1e427e..f5cfea8683 100644 --- a/guix/scripts/import/go.scm +++ b/guix/scripts/import/go.scm @@ -112,10 +112,10 @@ that are not yet in Guix")) (map package->definition* (apply go-module-recursive-import arguments)) ;; Single import. - (let ((sexp (apply go-module->guix-package arguments))) + (let ((sexp (apply go-module->guix-package* arguments))) (unless sexp - (leave (G_ "failed to download meta-data for module '~a'~%") - module-name)) + (leave (G_ "failed to download meta-data for module '~a'.~%") + name)) (package->definition* sexp)))))) (() (leave (G_ "too few arguments~%"))) diff --git a/tests/go.scm b/tests/go.scm index 6749f4585f..9e7223ff7c 100644 --- a/tests/go.scm +++ b/tests/go.scm @@ -410,6 +410,6 @@ package.") (nix-base32-string->bytevector "0sjjj9z1dhilhpc8pq4154czrb79z9cm044jvn75kxcjv6v5l2m5") #f))) - (go-module->guix-package "github.com/go-check/check"))))))) + (go-module->guix-package* "github.com/go-check/check"))))))) (test-end "go") -- cgit v1.2.3