@@ -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 \
@@ -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
new file mode 100644
@@ -0,0 +1,341 @@
+;;; 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-3" 'license:gpl3)
+ ("GPL" 'license:gpl?)
+ ("AGPL-3" 'license:agpl3)
+ ("AGPL" 'license:agpl?)
+ ("LGPL-2.1" 'license:lgpl2.1)
+ ("LGPL-3" 'license:lgpl3)
+ ("LGPL" 'license:lgpl?)
+ ("BSD-2" 'license:bsd-2)
+ ("BSD-3" '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
+ (match (assoc-ref egg-content 'license)
+ ((license)
+ (map string->license (string-split license #\/)))
+ (#f
+ '())))
+
+ (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.
;;;
-(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
new file mode 100644
@@ -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/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
new file mode 100644
@@ -0,0 +1,94 @@
+;;; 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-1-file "/tmp/guix-egg-1")
+
+(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-test egg-file matcher)
+ (call-with-output-file egg-file
+ (lambda (port)
+ (write egg-test port)))
+ (matcher (egg->guix-package "foo"
+ #:file egg-file
+ #:source (plain-file "foo-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 '(license:gpl3 license:expat))))
+
+(test-assert "egg->guix-package local file"
+ (eval-test-with-egg-file test-egg-1 test-egg-1-file match-chicken-foo))
+
+(test-end "egg")