From patchwork Wed Jun 2 15:18:22 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Xinglu Chen X-Patchwork-Id: 29798 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7720327BC81; Wed, 2 Jun 2021 16:19:20 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.8 required=5.0 tests=BAYES_00,DKIM_SIGNED, MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H4,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS, T_DKIM_INVALID,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.2 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 2639B27BC78 for ; Wed, 2 Jun 2021 16:19:19 +0100 (BST) Received: from localhost ([::1]:39952 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1loSeM-00073X-6Q for patchwork@mira.cbaines.net; Wed, 02 Jun 2021 11:19:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:42188) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1loSe6-00073B-Qx for guix-patches@gnu.org; Wed, 02 Jun 2021 11:19:02 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:57841) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1loSe6-00085T-JU for guix-patches@gnu.org; Wed, 02 Jun 2021 11:19:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1loSe6-0006bB-ES for guix-patches@gnu.org; Wed, 02 Jun 2021 11:19:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#48697] [PATCH v4] import: Add CHICKEN egg importer. Resent-From: Xinglu Chen Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 02 Jun 2021 15:19:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 48697 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 48697@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Received: via spool by 48697-submit@debbugs.gnu.org id=B48697.162264712125335 (code B ref 48697); Wed, 02 Jun 2021 15:19:02 +0000 Received: (at 48697) by debbugs.gnu.org; 2 Jun 2021 15:18:41 +0000 Received: from localhost ([127.0.0.1]:41154 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1loSdg-0006aU-VH for submit@debbugs.gnu.org; Wed, 02 Jun 2021 11:18:41 -0400 Received: from h87-96-130-155.cust.a3fiber.se ([87.96.130.155]:50158 helo=mail.yoctocell.xyz) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1loSdZ-0006a7-Vr for 48697@debbugs.gnu.org; Wed, 02 Jun 2021 11:18:34 -0400 From: Xinglu Chen DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=yoctocell.xyz; s=mail; t=1622647103; bh=mqc1zjc/dj94q0RNvDonYtZiFLr/GIORXyP6i0Mx7qQ=; h=From:To:Cc:Subject:In-Reply-To:References:Date; b=cLGd2ZIocrIQMcEJdgkqGZ+H/y2qT2lII2mjBQnVILoMY4Hb19VkjGL4T/SP6M1oi HW/4IvIuoEFrvIIaEJkpWq6owZGki70qX/mDrL6DlntkEnOP7fzGlbI1eU03+uAzmk j2qxVZ81Oc3Ivtnt2TG6N6uCa/oXWSe1NLOiGZoY= In-Reply-To: <9419cea6a6580c244a22d358c754032486f87b1c.1622485631.git.public@yoctocell.xyz> References: <9419cea6a6580c244a22d358c754032486f87b1c.1622485631.git.public@yoctocell.xyz> Message-Id: <0a08cf8ad3ee4db5002e683d48e45f8b1084cd02.1622646776.git.public@yoctocell.xyz> Date: Wed, 02 Jun 2021 17:18:22 +0200 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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. * etc/news.scm: Add entry. --- Changes since v3: * Fix generated license field, as pointed out by Ludovic. I also added a new test where the test egg only contains a single license, rather than multiple ones. * I took a look at the egg index[1] and added some more cases to the ‘string->license’ procedure. * Add news entry for the importer, both English and Chinese. My Chinese is not that good so the Chinese translation might not be the best, but still better than nothing I guess... Also, don’t forget to update the commit id in the news entry :) [1]: https://wiki.call-cc.org/chicken-projects/egg-index-5.html Makefile.am | 3 + doc/guix.texi | 24 +++ etc/news.scm | 24 +++ 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, 646 insertions(+), 2 deletions(-) create mode 100644 guix/import/egg.scm create mode 100644 guix/scripts/import/egg.scm create mode 100644 tests/egg.scm base-commit: f463f376e91ccc1fe4ab68d5e822b5d71a1234f5 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 0126099d68..0340fd4968 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -11601,6 +11601,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 @@ -11755,6 +11777,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..6eb483f7ff 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 @@ -22,6 +23,29 @@ (channel-news (version 0) + (entry (commit "0000000000000000000000000000000000000000") + (title + (en "New @command{guix import egg} command") + (zh "新的 @command{guix import egg} 命令")) + (body + (en "The new @command{guix import egg} command allows packagers to +generate a package definition or a template thereof given the name of a +CHICKEN egg package, like so: + +@example +guix import egg sourcehut +@end example + +Run @command{info \"(guix) Invoking guix import\"} for more info.") + (zh "新的 @command{guix import egg} 命令能让贡献者从一个CHICKEN egg生 +成一个包装或包装样板。 + +@example +guix import egg sourcehut +@end example + +想了解更多可以运行 @command{info \"(guix) Invoking guix import\"}。"))) + (entry (commit "2161820ebbbab62a5ce76c9101ebaec54dc61586") (title (en "Risk of local privilege escalation during user account creation") 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 @@ rather than \\n." ;;; 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 74cc5ebf9a..8fd944ff22 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 @@ -99,6 +100,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")