From bc4d81d267830a3b1ccb63198f4100cc836e4e4e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 15 May 2021 12:19:03 +0200 Subject: lint: archival: Lookup content in Disarchive database. * guix/lint.scm (lookup-disarchive-spec): New procedure. (check-archival): When 'lookup-content' returns #f, call 'lookup-disarchive-spec'. Call 'lookup-directory' on the result of 'lookup-directory'. * guix/download.scm (%disarchive-mirrors): Make public. * tests/lint.scm ("archival: missing content"): Set '%disarchive-mirrors'. ("archival: content unavailable but disarchive available"): New test. --- tests/lint.scm | 34 ++++++++++++++++++++++++++++++---- 1 file changed, 30 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/lint.scm b/tests/lint.scm index a2c8665142..d54fafc1d2 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2012, 2013 Cyril Roelandt ;;; Copyright © 2014, 2015, 2016 Eric Bavier -;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2015, 2016 Mathieu Lirzin ;;; Copyright © 2016 Hartmut Goebel ;;; Copyright © 2017 Alex Kost @@ -1008,10 +1008,13 @@ (define (warning-contains? str warnings) (method url-fetch) (uri "http://example.org/foo.tgz") (sha256 (make-bytevector 32)))) - (warnings (with-http-server '((404 "Not archived.")) + (warnings (with-http-server '((404 "Not archived.") + (404 "Not in Disarchive database.")) (parameterize ((%swh-base-url (%local-url))) - (check-archival (dummy-package "x" - (source origin))))))) + (mock ((guix download) %disarchive-mirrors + (list (%local-url))) + (check-archival (dummy-package "x" + (source origin)))))))) (warning-contains? "not archived" warnings))) (test-equal "archival: content available" @@ -1027,6 +1030,29 @@ (define (warning-contains? str warnings) (parameterize ((%swh-base-url (%local-url))) (check-archival (dummy-package "x" (source origin))))))) +(test-equal "archival: content unavailable but disarchive available" + '() + (let* ((origin (origin + (method url-fetch) + (uri "http://example.org/foo.tgz") + (sha256 (make-bytevector 32)))) + (disarchive (object->string + '(disarchive (version 0) + ... + "swh:1:dir:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"))) + ;; https://archive.softwareheritage.org/api/1/directory/ + (directory "[ { \"checksums\": {}, + \"dir_id\": \"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa\", + \"type\": \"file\", + \"name\": \"README\" + \"length\": 42 } ]")) + (with-http-server `((404 "") ;lookup-content + (200 ,disarchive) ;Disarchive database lookup + (200 ,directory)) ;lookup-directory + (mock ((guix download) %disarchive-mirrors (list (%local-url))) + (parameterize ((%swh-base-url (%local-url))) + (check-archival (dummy-package "x" (source origin)))))))) + (test-assert "archival: missing revision" (let* ((origin (origin (method git-fetch) -- cgit v1.2.3 From cfec09a9928e171a724f630ba652ea0241d52e92 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Mon, 17 May 2021 22:11:15 +0200 Subject: import: hackage: Prefix licenses with 'license:'. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/hackage.scm (string->license): Prefix the value of the license field with ‘license:’. * tests/hackage.scm (match-ghc-foo, match-ghc-foo-6, match-ghc-foo-revision): Adjust accordingly. Signed-off-by: Ludovic Courtès --- guix/import/hackage.scm | 27 ++++++++++++++------------- tests/hackage.scm | 7 ++++--- 2 files changed, 18 insertions(+), 16 deletions(-) (limited to 'tests') diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm index 9f992ffe8e..f94a1e7087 100644 --- a/guix/import/hackage.scm +++ b/guix/import/hackage.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2016 Nikita ;;; Copyright © 2018 Ricardo Wurmus ;;; Copyright © 2019 Robert Vollmert +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -163,22 +164,22 @@ (define string->license ;; https://www.haskell.org ;; /cabal/release/cabal-latest/doc/API/Cabal/Distribution-License.html. (match-lambda - ("GPL-2" 'gpl2) - ("GPL-3" 'gpl3) + ("GPL-2" 'license:gpl2) + ("GPL-3" 'license:gpl3) ("GPL" "'gpl??") - ("AGPL-3" 'agpl3) + ("AGPL-3" 'license:agpl3) ("AGPL" "'agpl??") - ("LGPL-2.1" 'lgpl2.1) - ("LGPL-3" 'lgpl3) + ("LGPL-2.1" 'license:lgpl2.1) + ("LGPL-3" 'license:lgpl3) ("LGPL" "'lgpl??") - ("BSD2" 'bsd-2) - ("BSD3" 'bsd-3) - ("BSD-3-Clause" 'bsd-3) - ("MIT" 'expat) - ("ISC" 'isc) - ("MPL" 'mpl2.0) - ("Apache-2.0" 'asl2.0) - ("PublicDomain" 'public-domain) + ("BSD2" 'license:bsd-2) + ("BSD3" 'license:bsd-3) + ("BSD-3-Clause" 'license:bsd-3) + ("MIT" 'license:expat) + ("ISC" 'license:isc) + ("MPL" 'license:mpl2.0) + ("Apache-2.0" 'license:asl2.0) + ("PublicDomain" 'license:public-domain) ((x) (string->license x)) ((lst ...) `(list ,@(map string->license lst))) (_ #f))) diff --git a/tests/hackage.scm b/tests/hackage.scm index 77e333cbfc..66a13d9881 100644 --- a/tests/hackage.scm +++ b/tests/hackage.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2019 Robert Vollmert +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -183,7 +184,7 @@ (define-package-matcher match-ghc-foo ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (define* (eval-test-with-cabal test-cabal matcher #:key (cabal-environment '())) (define port (open-input-string test-cabal)) @@ -232,7 +233,7 @@ (define-package-matcher match-ghc-foo-6 ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (test-assert "hackage->guix-package test 6" (eval-test-with-cabal test-cabal-6 match-ghc-foo-6)) @@ -362,7 +363,7 @@ (define-package-matcher match-ghc-foo-revision ('home-page "http://test.org") ('synopsis (? string?)) ('description (? string?)) - ('license 'bsd-3))) + ('license 'license:bsd-3))) (test-assert "hackage->guix-package test cabal revision" (eval-test-with-cabal test-cabal-revision match-ghc-foo-revision)) -- cgit v1.2.3 From 3f5bc6cbb34e1b57829ce3bf482310c49f03d3c3 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Mon, 24 May 2021 23:24:28 +0200 Subject: import: opam: Generate license for package. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/opam.scm (opam->guix-package): Generate license for the ‘license’ field. * tests/opam.scm (test-opam-file): Update accordingly. ("opam->guix-package"): Likewise. Signed-off-by: Ludovic Courtès --- guix/import/opam.scm | 4 +++- tests/opam.scm | 4 +++- 2 files changed, 6 insertions(+), 2 deletions(-) (limited to 'tests') diff --git a/guix/import/opam.scm b/guix/import/opam.scm index 670973b193..0201376457 100644 --- a/guix/import/opam.scm +++ b/guix/import/opam.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller ;;; Copyright © 2020 Martin Becze +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -335,7 +336,8 @@ (define* (opam->guix-package name #:key (repo 'opam) version) (home-page ,(metadata-ref opam-content "homepage")) (synopsis ,(metadata-ref opam-content "synopsis")) (description ,(metadata-ref opam-content "description")) - (license #f)) + (license ,(spdx-string->license + (metadata-ref opam-content "license")))) (filter (lambda (name) (not (member name '("dune" "jbuilder")))) diff --git a/tests/opam.scm b/tests/opam.scm index 11984b56a6..f1e3b70cb0 100644 --- a/tests/opam.scm +++ b/tests/opam.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Julien Lepiller +;;; Copyright © 2021 Xinglu Chen ;;; ;;; This file is part of GNU Guix. ;;; @@ -55,6 +56,7 @@ (define test-opam-file synopsis: \"Some example package\" description: \"\"\" This package is just an example.\"\"\" +license: \"BSD-3-Clause\" url { src: \"https://example.org/foo-1.0.0.tar.gz\" checksum: \"md5=74c6e897658e820006106f45f736381f\" @@ -109,7 +111,7 @@ (define test-repo ('home-page "https://example.org/") ('synopsis "Some example package") ('description "This package is just an example.") - ('license #f)) + ('license 'license:bsd-3)) (string=? (bytevector->nix-base32-string test-source-hash) hash)) -- cgit v1.2.3 From d7c356edb9719f1e236ee926c0288f914076481a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 28 May 2021 22:43:21 +0200 Subject: gnu-maintenance: 'release-file?' accepts 'v' prefix as in "PKG-v1.2.tgz". * guix/gnu-maintenance.scm (%tarball-rx, %package-name-rx): Accept 'v' and 'V' prefixes. Accept ".tgz" extension. * tests/gnu-maintenance.scm ("release-file?"): Add test. --- guix/gnu-maintenance.scm | 5 +++-- tests/gnu-maintenance.scm | 3 ++- 2 files changed, 5 insertions(+), 3 deletions(-) (limited to 'tests') diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm index fece84b341..4e3a54dcab 100644 --- a/guix/gnu-maintenance.scm +++ b/guix/gnu-maintenance.scm @@ -243,7 +243,8 @@ (define %tarball-rx ;; The "-src" pattern is for "TeXmacs-1.0.7.9-src.tar.gz". ;; The "-gnu[0-9]" pattern is for "icecat-38.4.0-gnu1.tar.bz2". ;; Accept underscores as in "PKG_1.2.tar.gz" for some non-GNU packages. - (make-regexp "^([^.]+)[-_]([0-9]|[^-])+(-(src|[sS]ource|gnu[0-9]))?\\.(tar\\.|zip$)")) + ;; Accept 'v' or 'V' prefix as in 'PKG-v2.3.tgz'. + (make-regexp "^([^.]+)[-_][vV]?([0-9]|[^-])+(-(src|[sS]ource|gnu[0-9]))?\\.(tar\\.|tgz|zip$)")) (define %alpha-tarball-rx (make-regexp "^.*-.*[0-9](-|~)?(alpha|beta|rc|RC|cvs|svn|git)-?[0-9\\.]*\\.tar\\.")) @@ -596,7 +597,7 @@ (define (latest-gnu-release package) (define %package-name-rx ;; Regexp for a package name, e.g., "foo-X.Y". Since TeXmacs uses ;; "TeXmacs-X.Y-src", the `-src' suffix is allowed. - (make-regexp "^(.*)[-_](([0-9]|\\.)+)(-src|\\.src|\\.orig)?")) + (make-regexp "^(.*)[-_][vV]?(([0-9]|\\.)+)(-src|\\.src|\\.orig)?")) (define (gnu-package-name->name+version name+version) "Return the package name and version number extracted from NAME+VERSION." diff --git a/tests/gnu-maintenance.scm b/tests/gnu-maintenance.scm index 837b80063a..c04d8ba733 100644 --- a/tests/gnu-maintenance.scm +++ b/tests/gnu-maintenance.scm @@ -34,7 +34,8 @@ (define-module (test-gnu-maintenance) ("mediainfo" "mediainfo_20.09.tar.xz") ("exiv2" "exiv2-0.27.3-Source.tar.gz") ("mpg321" "mpg321_0.3.2.orig.tar.gz") - ("bvi" "bvi-1.4.1.src.tar.gz"))) + ("bvi" "bvi-1.4.1.src.tar.gz") + ("hostscope" "hostscope-V2.1.tgz"))) (every (lambda (project+file) (not (apply release-file? project+file))) '(("guile" "guile-www-1.1.1.tar.gz") -- cgit v1.2.3 From bdc298ecee15283451d3aa20a849dd7bb22c8538 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Wed, 2 Jun 2021 17:18:22 +0200 Subject: import: Add CHICKEN egg importer. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/import/egg.scm: New file. * guix/scripts/import/egg.scm: New file. * tests/egg.scm: New file. * Makefile.am (MODULES, SCM_TESTS): Register them. * po/guix/POTFILES.in: Likewise. * guix/scripts/import.scm (importers): Add egg importer. * doc/guix.texi (Invoking guix import, Invoking guix refresh): Document it. Signed-off-by: Ludovic Courtès --- Makefile.am | 3 + doc/guix.texi | 24 +++ etc/news.scm | 1 + guix/import/egg.scm | 352 ++++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 4 +- guix/scripts/import/egg.scm | 107 ++++++++++++++ po/guix/POTFILES.in | 2 + tests/egg.scm | 132 +++++++++++++++++ 8 files changed, 623 insertions(+), 2 deletions(-) create mode 100644 guix/import/egg.scm create mode 100644 guix/scripts/import/egg.scm create mode 100644 tests/egg.scm (limited to 'tests') diff --git a/Makefile.am b/Makefile.am index 8db7d6a320..3e72c3ebd0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -248,6 +248,7 @@ MODULES = \ guix/import/cpan.scm \ guix/import/cran.scm \ guix/import/crate.scm \ + guix/import/egg.scm \ guix/import/elpa.scm \ guix/import/gem.scm \ guix/import/github.scm \ @@ -293,6 +294,7 @@ MODULES = \ guix/scripts/challenge.scm \ guix/scripts/import/crate.scm \ guix/scripts/import/cran.scm \ + guix/scripts/import/egg.scm \ guix/scripts/import/elpa.scm \ guix/scripts/import/gem.scm \ guix/scripts/import/gnu.scm \ @@ -449,6 +451,7 @@ SCM_TESTS = \ tests/debug-link.scm \ tests/derivations.scm \ tests/discovery.scm \ + tests/egg.scm \ tests/elpa.scm \ tests/file-systems.scm \ tests/gem.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 43198a0af1..ed442d3f9b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11600,6 +11600,28 @@ using this mode, the symbol of the package is made by appending the version to its name, so that multiple versions of the same package can coexist. @end table + +@item egg +@cindex egg +Import metadata for @uref{https://wiki.call-cc.org/eggs, CHICKEN eggs}. +The information is taken from @file{PACKAGE.egg} files found in the +@uref{git://code.call-cc.org/eggs-5-latest, eggs-5-latest} Git +repository. However, it does not provide all the information that we +need, there is no ``description'' field, and the licenses used are not +always precise (BSD is often used instead of BSD-N). + +@example +guix import egg sourcehut +@end example + +Additional options include: +@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 @end table The structure of the @command{guix import} code is modular. It would be @@ -11754,6 +11776,8 @@ the updater for KDE packages; the updater for X.org packages; @item kernel.org the updater for packages hosted on kernel.org; +@item egg +the updater for @uref{https://wiki.call-cc.org/eggs/, Egg} packages; @item elpa the updater for @uref{https://elpa.gnu.org/, ELPA} packages; @item cran diff --git a/etc/news.scm b/etc/news.scm index 65d83061df..f61c4d8ccf 100644 --- a/etc/news.scm +++ b/etc/news.scm @@ -14,6 +14,7 @@ ;; Copyright © 2021 Zhu Zihao ;; Copyright © 2021 Chris Marusich ;; Copyright © 2021 Maxime Devos +;; Copyright © 2021 Xinglu Chen ;; ;; Copying and distribution of this file, with or without modification, are ;; permitted in any medium without royalty provided the copyright notice and diff --git a/guix/import/egg.scm b/guix/import/egg.scm new file mode 100644 index 0000000000..26f8364732 --- /dev/null +++ b/guix/import/egg.scm @@ -0,0 +1,352 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; +;;; 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 egg) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-71) + #:use-module (gcrypt hash) + #:use-module (guix git) + #:use-module (guix i18n) + #:use-module (guix base32) + #:use-module (guix diagnostics) + #:use-module (guix memoization) + #:use-module (guix packages) + #:use-module (guix upstream) + #:use-module (guix build-system) + #:use-module (guix build-system chicken) + #:use-module (guix store) + #:use-module ((guix download) #:select (download-to-store url-fetch)) + #:use-module (guix import utils) + #:use-module ((guix licenses) #:prefix license:) + #:export (egg->guix-package + egg-recursive-import + %egg-updater + + ;; For tests. + guix-package->egg-name)) + +;;; Commentary: +;;; +;;; (guix import egg) provides package importer for CHICKEN eggs. See the +;;; official specification format for eggs +;;; . +;;; +;;; The following happens under the hood: +;;; +;;; * is a Git repository that contains +;;; the latest version of all CHICKEN eggs. We look clone this repository +;;; and retrieve the latest version number, and the PACKAGE.egg file, which +;;; contains a list of lists containing metadata about the egg. +;;; +;;; * All the eggs are stored as tarballs at +;;; , so we grab the tarball for +;;; the egg from there. +;;; +;;; * The rest of the package fields will be parsed from the PACKAGE.egg file. +;;; +;;; Todos: +;;; +;;; * Support for CHICKEN 4? +;;; +;;; * Some packages will specify a specific version of a depencency in the +;;; PACKAGE.egg file, how should we handle this? +;;; +;;; Code: + + +;;; +;;; Egg metadata fetcher and helper functions. +;;; + +(define package-name-prefix "chicken-") + +(define %eggs-url + (make-parameter "https://code.call-cc.org/egg-tarballs/5")) + +(define %eggs-home-page + (make-parameter "https://wiki.call-cc.org/egg")) + +(define (egg-source-url name version) + "Return the URL to the source tarball for version VERSION of the CHICKEN egg +NAME." + (string-append (%eggs-url) "/" name "/" name "-" version ".tar.gz")) + +(define (egg-name->guix-name name) + "Return the package name for CHICKEN egg NAME." + (string-append package-name-prefix name)) + +(define (eggs-repository) + "Update or fetch the latest version of the eggs repository and return the path +to the repository." + (let* ((url "git://code.call-cc.org/eggs-5-latest") + (directory commit _ (update-cached-checkout url))) + directory)) + +(define (egg-directory name) + "Return the directory containing the source code for the egg NAME." + (let ((eggs-directory (eggs-repository))) + (string-append eggs-directory "/" name))) + +(define (find-latest-version name) + "Get the latest version of the egg NAME." + (let ((directory (scandir (egg-directory name)))) + (if directory + (last directory) + #f))) + +(define* (egg-metadata name #:optional file) + "Return the package metadata file for the egg NAME, or if FILE is specified, +return the package metadata in FILE." + (call-with-input-file (or file + (string-append (egg-directory name) "/" + (find-latest-version name) + "/" name ".egg")) + read)) + +(define (guix-name->egg-name name) + "Return the CHICKEN egg name corresponding to the Guix package NAME." + (if (string-prefix? package-name-prefix name) + (string-drop name (string-length package-name-prefix)) + name)) + +(define (guix-package->egg-name package) + "Return the CHICKEN egg name of the Guix CHICKEN PACKAGE." + (or (assq-ref (package-properties package) 'upstream-name) + (guix-name->egg-name (package-name package)))) + +(define (egg-package? package) + "Check if PACKAGE is an CHICKEN egg package." + (and (eq? (package-build-system package) chicken-build-system) + (string-prefix? package-name-prefix (package-name package)))) + +(define string->license + ;; Doesn't seem to use a specific format. + ;; + (match-lambda + ("GPL-2" 'license:gpl2) + ("GPL-2+" 'license:gpl2+) + ("GPL-3" 'license:gpl3) + ("GPL-3+" 'license:gpl3+) + ("GPL" 'license:gpl?) + ("AGPL-3" 'license:agpl3) + ("AGPL" 'license:agpl?) + ("LGPL-2.0" 'license:lgpl2.0) + ("LGPL-2.0+" 'license:lgpl2.0+) + ("LGPL-2.1" 'license:lgpl2.1) + ("LGPL-2.1+" 'license:lgpl2.1+) + ("LGPL-3" 'license:lgpl3) + ("LGPL-3" 'license:lgpl3+) + ("LGPL" 'license:lgpl?) + ("BSD-1-Clause" 'license:bsd-1) + ("BSD-2-Clause" 'license:bsd-2) + ("BSD-3-Clause" 'license:bsd-3) + ("BSD" 'license:bsd?) + ("MIT" 'license:expat) + ("ISC" 'license:isc) + ("Artistic-2" 'license:artistic2.0) + ("Apache-2.0" 'license:asl2.0) + ("Public Domain" 'license:public-domain) + ((x) (string->license x)) + ((lst ...) `(list ,@(map string->license lst))) + (_ #f))) + + +;;; +;;; Egg importer. +;;; + +(define* (egg->guix-package name #:key (file #f) (source #f)) + "Import CHICKEN egg NAME from and return a record type for the +egg, or #f on failure. FILE is the filepath to the NAME.egg file. SOURCE is +the a ``file-like'' object containing the source code corresonding to the egg. +If SOURCE is not specified, the tarball for the egg will be downloaded. + +Specifying the SOURCE argument is mainly useful for developing a CHICKEN egg +locally. Note that if FILE and SOURCE are specified, recursive import will +not work." + (define egg-content (if file + (egg-metadata name file) + (egg-metadata name))) + (if (not egg-content) + (values #f '()) ; egg doesn't exist + (let* ((version* (or (assoc-ref egg-content 'version) + (find-latest-version name))) + (version (if (list? version*) (first version*) version*)) + (source-url (if source #f (egg-source-url name version))) + (tarball (if source + #f + (with-store store + (download-to-store store source-url))))) + + (define egg-home-page + (string-append (%eggs-home-page) "/" name)) + + (define egg-synopsis + (match (assoc-ref egg-content 'synopsis) + ((synopsis) synopsis) + (_ #f))) + + (define egg-licenses + (let ((licenses* + (match (assoc-ref egg-content 'license) + ((license) + (map string->license (string-split license #\/))) + (#f + '())))) + (match licenses* + ((license) license) + ((license1 license2 ...) `(list ,@licenses*))))) + + (define (maybe-symbol->string sym) + (if (symbol? sym) (symbol->string sym) sym)) + + (define (prettify-system-dependency name) + ;; System dependencies sometimes have spaces and/or upper case + ;; letters in them. + ;; + ;; There will probably still be some weird edge cases. + (string-map (lambda (char) + (case char + ((#\space) #\-) + (else char))) + (maybe-symbol->string name))) + + (define* (egg-parse-dependency name #:key (system? #f)) + (define extract-name + (match-lambda + ((name version) name) + (name name))) + + (define (prettify-name name) + (if system? + (prettify-system-dependency name) + (maybe-symbol->string name))) + + (let ((name (prettify-name (extract-name name)))) + ;; Dependencies are sometimes specified as symbols and sometimes + ;; as strings + (list (string-append (if system? "" package-name-prefix) + name) + (list 'unquote + (string->symbol (string-append + (if system? "" package-name-prefix) + name)))))) + + (define egg-propagated-inputs + (let ((dependencies (assoc-ref egg-content 'dependencies))) + (if (list? dependencies) + (map egg-parse-dependency + dependencies) + '()))) + + ;; TODO: Or should these be propagated? + (define egg-inputs + (let ((dependencies (assoc-ref egg-content 'foreign-dependencies))) + (if (list? dependencies) + (map (lambda (name) + (egg-parse-dependency name #:system? #t)) + dependencies) + '()))) + + (define egg-native-inputs + (let* ((test-dependencies (or (assoc-ref egg-content + 'test-dependencies) + '())) + (build-dependencies (or (assoc-ref egg-content + 'build-dependencies) + '())) + (test+build-dependencies (append test-dependencies + build-dependencies))) + (match test+build-dependencies + ((_ _ ...) (map egg-parse-dependency + test+build-dependencies)) + (() '())))) + + ;; Copied from (guix import hackage). + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (values + `(package + (name ,(egg-name->guix-name name)) + (version ,version) + (source + ,(if source + source + `(origin + (method url-fetch) + (uri ,source-url) + (sha256 + (base32 ,(if tarball + (bytevector->nix-base32-string + (file-sha256 tarball)) + "failed to download tar archive")))))) + (build-system chicken-build-system) + (arguments ,(list 'quasiquote (list #:egg-name name))) + ,@(maybe-inputs 'native-inputs egg-native-inputs) + ,@(maybe-inputs 'inputs egg-inputs) + ,@(maybe-inputs 'propagated-inputs egg-propagated-inputs) + (home-page ,egg-home-page) + (synopsis ,egg-synopsis) + (description #f) + (license ,egg-licenses)) + (filter (lambda (name) + (not (member name '("srfi-4")))) + (map (compose guix-name->egg-name first) + (append egg-propagated-inputs + egg-native-inputs))))))) + +(define egg->guix-package/m ;memoized variant + (memoize egg->guix-package)) + +(define (egg-recursive-import package-name) + (recursive-import package-name + #:repo->guix-package (lambda* (name #:key version repo) + (egg->guix-package/m name)) + #:guix-name egg-name->guix-name)) + + +;;; +;;; Updater. +;;; + +(define (latest-release package) + "Return an @code{} for the latest release of PACKAGE." + (let* ((egg-name (guix-package->egg-name package)) + (version (find-latest-version egg-name)) + (source-url (egg-source-url egg-name version))) + (upstream-source + (package (package-name package)) + (version version) + (urls (list source-url))))) + +(define %egg-updater + (upstream-updater + (name 'egg) + (description "Updater for CHICKEN egg packages") + (pred egg-package?) + (latest latest-release))) + +;;; egg.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index bbd9a3b190..f53d1ac1f4 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -76,8 +76,8 @@ (define %standard-import-options '()) ;;; Entry point. ;;; -(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "elpa" "gem" - "go" "cran" "crate" "texlive" "json" "opam")) +(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa" + "gem" "go" "cran" "crate" "texlive" "json" "opam")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/egg.scm b/guix/scripts/import/egg.scm new file mode 100644 index 0000000000..7dbd6fcd5a --- /dev/null +++ b/guix/scripts/import/egg.scm @@ -0,0 +1,107 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; +;;; 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 egg) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix scripts) + #:use-module (guix import egg) + #: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-egg)) + + +;;; +;;; Command-line options. +;;; + +(define %default-options + '()) + +(define (show-help) + (display (G_ "Usage: guix import egg PACKAGE-NAME +Import and convert the egg package for PACKAGE-NAME.\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")) + (newline) + (show-bug-report-information)) + +(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 egg"))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) + %standard-import-options)) + + +;;; +;;; Entry point. +;;; + +(define (guix-import-egg . 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)) + (repo (and=> (assoc-ref opts 'repo) string->symbol)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (if (assoc-ref opts 'recursive) + ;; Recursive import + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (egg-recursive-import package-name)) + ;; Single import + (let ((sexp (egg->guix-package package-name))) + (unless sexp + (leave (G_ "failed to download meta-data for package '~a'~%") + package-name)) + sexp))) + (() + (leave (G_ "too few arguments~%"))) + ((many ...) + (leave (G_ "too many arguments~%")))))) diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in index 727f820cca..14324b25de 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -7,6 +7,7 @@ gnu/system.scm gnu/services/shepherd.scm gnu/system/mapped-devices.scm gnu/system/shadow.scm +guix/import/egg.scm guix/import/opam.scm gnu/installer.scm gnu/installer/connman.scm @@ -100,6 +101,7 @@ guix/scripts/environment.scm guix/scripts/time-machine.scm guix/scripts/import/cpan.scm guix/scripts/import/crate.scm +guix/scripts/import/egg.scm guix/scripts/import/gem.scm guix/scripts/import/gnu.scm guix/scripts/import/go.scm diff --git a/tests/egg.scm b/tests/egg.scm new file mode 100644 index 0000000000..0884d8d429 --- /dev/null +++ b/tests/egg.scm @@ -0,0 +1,132 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2021 Xinglu Chen +;;; +;;; 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-eggs) + #:use-module (guix import egg) + #:use-module (guix gexp) + #:use-module (guix base32) + #:use-module (gcrypt hash) + #:use-module (guix tests) + #:use-module ((guix build syscalls) #:select (mkdtemp!)) + #:use-module ((guix build utils) #:select (delete-file-recursively mkdir-p which)) + #:use-module ((guix utils) #:select (call-with-temporary-output-file)) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (web uri) + #:use-module (ice-9 match)) + +(define test-egg-1 + '((synopsis "Example egg") + (license "GPL-3/MIT") + (version "1.0.0") + (test-dependencies test srfi-1) + (foreign-dependencies libgit2) + (build-dependencies begin-syntax) + (dependencies datatype) + (author "John Doe"))) + +(define test-egg-2 + '((synopsis "Example egg") + (license "GPL-3+") + (version "0.3") + (test-dependencies test) + (foreign-dependencies libgit2) + (build-dependencies begin-syntax) + (dependencies datatype) + (author "Alice Bobson"))) + +(define test-egg-1-file "/tmp/guix-egg-1") +(define test-egg-2-file "/tmp/guix-egg-2") + +(test-begin "egg") + +(test-equal "guix-package->egg-name" + "bar" + (guix-package->egg-name + (dummy-package "dummy" + (name "chicken-bar")))) + +;; Copied from tests/hackage.scm +(define-syntax-rule (define-package-matcher name pattern) + (define* (name obj) + (match obj + (pattern #t) + (x (pk 'fail x #f))))) + +(define (eval-test-with-egg-file egg-name egg-test egg-file matcher) + (call-with-output-file egg-file + (lambda (port) + (write egg-test port))) + (matcher (egg->guix-package egg-name + #:file egg-file + #:source (plain-file + (string-append egg-name "-egg") + "content")))) + +(define-package-matcher match-chicken-foo + ('package + ('name "chicken-foo") + ('version "1.0.0") + ('source (? file-like? source)) + ('build-system 'chicken-build-system) + ('arguments ('quasiquote ('#:egg-name "foo"))) + ('native-inputs + ('quasiquote + (("chicken-test" ('unquote chicken-test)) + ("chicken-srfi-1" ('unquote chicken-srfi-1)) + ("chicken-begin-syntax" ('unquote chicken-begin-syntax))))) + ('inputs + ('quasiquote + (("libgit2" ('unquote libgit2))))) + ('propagated-inputs + ('quasiquote + (("chicken-datatype" ('unquote chicken-datatype))))) + ('home-page "https://wiki.call-cc.org/egg/foo") + ('synopsis "Example egg") + ('description #f) + ('license '(list license:gpl3 license:expat)))) + +(define-package-matcher match-chicken-bar + ('package + ('name "chicken-bar") + ('version "0.3") + ('source (? file-like? source)) + ('build-system 'chicken-build-system) + ('arguments ('quasiquote ('#:egg-name "bar"))) + ('native-inputs + ('quasiquote + (("chicken-test" ('unquote chicken-test)) + ("chicken-begin-syntax" ('unquote chicken-begin-syntax))))) + ('inputs + ('quasiquote + (("libgit2" ('unquote libgit2))))) + ('propagated-inputs + ('quasiquote + (("chicken-datatype" ('unquote chicken-datatype))))) + ('home-page "https://wiki.call-cc.org/egg/bar") + ('synopsis "Example egg") + ('description #f) + ('license 'license:gpl3+))) + +(test-assert "egg->guix-package local file, multiple licenses" + (eval-test-with-egg-file "foo" test-egg-1 test-egg-1-file match-chicken-foo)) + +(test-assert "egg->guix-package local file, single license" + (eval-test-with-egg-file "bar" test-egg-2 test-egg-2-file match-chicken-bar)) + +(test-end "egg") -- cgit v1.2.3 From 82b0e27de109b38ed44f67434a96460c4a7f9217 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sun, 9 May 2021 14:35:57 +0200 Subject: lint: tests-true: Check if tests are enabled when cross-compiling. * guix/lint.scm (check-tests-true): New linter. (%local-checkers)[tests-true]: Add it. * tests/lint.scm ("tests-true: #:tests? must not be set to #t") ("tests-true: absent #:tests? is acceptable") ("tests-true: #:tests? #f is acceptable") ("tests-true: #:tests? #t acceptable when compiling natively"): Test it. Signed-off-by: Mathieu Othacehe --- guix/lint.scm | 26 ++++++++++++++++++++++++++ tests/lint.scm | 23 +++++++++++++++++++++++ 2 files changed, 49 insertions(+) (limited to 'tests') diff --git a/guix/lint.scm b/guix/lint.scm index 41dd5d0633..5cd6db5842 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -12,6 +12,7 @@ ;;; Copyright © 2020 Chris Marusich ;;; Copyright © 2020 Timothy Sample ;;; Copyright © 2021 Xinglu Chen +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -96,6 +97,7 @@ (define-module (guix lint) check-archival check-profile-collisions check-haskell-stackage + check-tests-true lint-warning lint-warning? @@ -191,6 +193,26 @@ (define (check-name package) #:field 'name))) (else '())))) +(define (check-tests-true package) + "Check whether PACKAGE explicitly requests to run tests, which is +superfluous when building natively and incorrect when cross-compiling." + (define (tests-explicitly-enabled?) + (apply (lambda* (#:key tests? #:allow-other-keys) + (eq? tests? #t)) + (package-arguments package))) + (if (and (tests-explicitly-enabled?) + ;; Some packages, e.g. gnutls, set #:tests? + ;; differently depending on whether it is being + ;; cross-compiled. + (parameterize ((%current-target-system "aarch64-linux-gnu")) + (tests-explicitly-enabled?))) + (list (make-warning package + ;; TRANSLATORS: #:tests? and #t are Scheme constants + ;; and must not be translated. + (G_ "#:tests? must not be explicitly set to #t") + #:field 'arguments)) + '())) + (define (properly-starts-sentence? s) (string-match "^[(\"'`[:upper:][:digit:]]" s)) @@ -1524,6 +1546,10 @@ (define %local-checkers (name 'name) (description "Validate package names") (check check-name)) + (lint-checker + (name 'tests-true) + (description "Check if tests are explicitly enabled") + (check check-tests-true)) (lint-checker (name 'description) (description "Validate package descriptions") diff --git a/tests/lint.scm b/tests/lint.scm index d54fafc1d2..f4c3dde774 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -277,6 +277,29 @@ (define (warning-contains? str warnings) (let ((pkg (dummy-package "under_score"))) (check-name pkg)))) +(test-equal "tests-true: #:tests? must not be set to #t" + "#:tests? must not be explicitly set to #t" + (single-lint-warning-message + (let ((pkg (dummy-package "x" (arguments '(#:tests? #t))))) + (check-tests-true pkg)))) + +(test-equal "tests-true: absent #:tests? is acceptable" + '() + (let ((pkg (dummy-package "x"))) + (check-tests-true pkg))) + +(test-equal "tests-true: #:tests? #f is acceptable" + '() + (let ((pkg (dummy-package "x" (arguments '(#:tests? #f))))) + (check-tests-true pkg))) + +(test-equal "tests-true: #:tests? #t acceptable when compiling natively" + '() + (let ((pkg (dummy-package "x" + (arguments + `(#:tests? ,(not (%current-target-system))))))) + (check-tests-true pkg))) + (test-equal "inputs: pkg-config is probably a native input" "'pkg-config' should probably be a native input" (single-lint-warning-message -- cgit v1.2.3