import: Add CHICKEN egg importer.
* 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 <ludo@gnu.org>
This commit is contained in:
parent
1e8ebb16c9
commit
bdc298ecee
8 changed files with 623 additions and 2 deletions
|
@ -248,6 +248,7 @@ MODULES = \
|
||||||
guix/import/cpan.scm \
|
guix/import/cpan.scm \
|
||||||
guix/import/cran.scm \
|
guix/import/cran.scm \
|
||||||
guix/import/crate.scm \
|
guix/import/crate.scm \
|
||||||
|
guix/import/egg.scm \
|
||||||
guix/import/elpa.scm \
|
guix/import/elpa.scm \
|
||||||
guix/import/gem.scm \
|
guix/import/gem.scm \
|
||||||
guix/import/github.scm \
|
guix/import/github.scm \
|
||||||
|
@ -293,6 +294,7 @@ MODULES = \
|
||||||
guix/scripts/challenge.scm \
|
guix/scripts/challenge.scm \
|
||||||
guix/scripts/import/crate.scm \
|
guix/scripts/import/crate.scm \
|
||||||
guix/scripts/import/cran.scm \
|
guix/scripts/import/cran.scm \
|
||||||
|
guix/scripts/import/egg.scm \
|
||||||
guix/scripts/import/elpa.scm \
|
guix/scripts/import/elpa.scm \
|
||||||
guix/scripts/import/gem.scm \
|
guix/scripts/import/gem.scm \
|
||||||
guix/scripts/import/gnu.scm \
|
guix/scripts/import/gnu.scm \
|
||||||
|
@ -449,6 +451,7 @@ SCM_TESTS = \
|
||||||
tests/debug-link.scm \
|
tests/debug-link.scm \
|
||||||
tests/derivations.scm \
|
tests/derivations.scm \
|
||||||
tests/discovery.scm \
|
tests/discovery.scm \
|
||||||
|
tests/egg.scm \
|
||||||
tests/elpa.scm \
|
tests/elpa.scm \
|
||||||
tests/file-systems.scm \
|
tests/file-systems.scm \
|
||||||
tests/gem.scm \
|
tests/gem.scm \
|
||||||
|
|
|
@ -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
|
version to its name, so that multiple versions of the same package can
|
||||||
coexist.
|
coexist.
|
||||||
@end table
|
@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
|
@end table
|
||||||
|
|
||||||
The structure of the @command{guix import} code is modular. It would be
|
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;
|
the updater for X.org packages;
|
||||||
@item kernel.org
|
@item kernel.org
|
||||||
the updater for packages hosted on 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
|
@item elpa
|
||||||
the updater for @uref{https://elpa.gnu.org/, ELPA} packages;
|
the updater for @uref{https://elpa.gnu.org/, ELPA} packages;
|
||||||
@item cran
|
@item cran
|
||||||
|
|
|
@ -14,6 +14,7 @@
|
||||||
;; Copyright © 2021 Zhu Zihao <all_but_last@163.com>
|
;; Copyright © 2021 Zhu Zihao <all_but_last@163.com>
|
||||||
;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
|
;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
|
||||||
;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
|
||||||
|
;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
;;
|
;;
|
||||||
;; Copying and distribution of this file, with or without modification, are
|
;; Copying and distribution of this file, with or without modification, are
|
||||||
;; permitted in any medium without royalty provided the copyright notice and
|
;; permitted in any medium without royalty provided the copyright notice and
|
||||||
|
|
352
guix/import/egg.scm
Normal file
352
guix/import/egg.scm
Normal file
|
@ -0,0 +1,352 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix import 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
|
||||||
|
;;; <https://wiki.call-cc.org/man/5/Egg%20specification%20format>.
|
||||||
|
;;;
|
||||||
|
;;; The following happens under the hood:
|
||||||
|
;;;
|
||||||
|
;;; * <git://code.call-cc.org/eggs-5-latest> 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
|
||||||
|
;;; <https://code.call-cc.org/egg-tarballs/5>, 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.
|
||||||
|
;; <https://wiki.call-cc.org/eggs-licensing>
|
||||||
|
(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 <package> 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{<upstream-source>} 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
|
|
@ -76,8 +76,8 @@ rather than \\n."
|
||||||
;;; Entry point.
|
;;; Entry point.
|
||||||
;;;
|
;;;
|
||||||
|
|
||||||
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "elpa" "gem"
|
(define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
|
||||||
"go" "cran" "crate" "texlive" "json" "opam"))
|
"gem" "go" "cran" "crate" "texlive" "json" "opam"))
|
||||||
|
|
||||||
(define (resolve-importer name)
|
(define (resolve-importer name)
|
||||||
(let ((module (resolve-interface
|
(let ((module (resolve-interface
|
||||||
|
|
107
guix/scripts/import/egg.scm
Normal file
107
guix/scripts/import/egg.scm
Normal file
|
@ -0,0 +1,107 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (guix scripts import 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~%"))))))
|
|
@ -7,6 +7,7 @@ gnu/system.scm
|
||||||
gnu/services/shepherd.scm
|
gnu/services/shepherd.scm
|
||||||
gnu/system/mapped-devices.scm
|
gnu/system/mapped-devices.scm
|
||||||
gnu/system/shadow.scm
|
gnu/system/shadow.scm
|
||||||
|
guix/import/egg.scm
|
||||||
guix/import/opam.scm
|
guix/import/opam.scm
|
||||||
gnu/installer.scm
|
gnu/installer.scm
|
||||||
gnu/installer/connman.scm
|
gnu/installer/connman.scm
|
||||||
|
@ -100,6 +101,7 @@ guix/scripts/environment.scm
|
||||||
guix/scripts/time-machine.scm
|
guix/scripts/time-machine.scm
|
||||||
guix/scripts/import/cpan.scm
|
guix/scripts/import/cpan.scm
|
||||||
guix/scripts/import/crate.scm
|
guix/scripts/import/crate.scm
|
||||||
|
guix/scripts/import/egg.scm
|
||||||
guix/scripts/import/gem.scm
|
guix/scripts/import/gem.scm
|
||||||
guix/scripts/import/gnu.scm
|
guix/scripts/import/gnu.scm
|
||||||
guix/scripts/import/go.scm
|
guix/scripts/import/go.scm
|
||||||
|
|
132
tests/egg.scm
Normal file
132
tests/egg.scm
Normal file
|
@ -0,0 +1,132 @@
|
||||||
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
|
;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of GNU Guix.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
(define-module (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")
|
Reference in a new issue