@@ -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 \
@@ -11594,6 +11594,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
@@ -11748,6 +11770,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,363 @@
+;;; 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 (ice-9 string-fun)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-11)
+ #:use-module (web uri)
+ #:use-module (sxml simple)
+ #:use-module ((sxml xpath) #:hide (filter))
+ #:use-module (gcrypt hash)
+ #:use-module (guix git)
+ #:use-module (guix i18n)
+ #:use-module (guix http-client)
+ #:use-module (guix base32)
+ #:use-module (guix memoization)
+ #:use-module (guix packages)
+ #:use-module (guix upstream)
+ #:use-module (guix build-system)
+ #: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
+
+ 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://api.call-cc.org/5/doc"))
+
+(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 (get-eggs-repository)
+ "Update or fetch the latest version of the eggs repository and return the path
+to the repository."
+ (let*-values (((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 (get-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)
+ (begin
+ (format #t (G_ "Package not found in eggs repository: ~a~%") name)
+ #f))))
+
+(define (get-metadata port)
+ "Parse the egg metadata from PORT."
+ (let ((content (read port)))
+ (close-port port)
+ content))
+
+(define (egg-metadata name)
+ "Return the package metadata file for the egg NAME."
+ (let ((version (find-latest-version name)))
+ (if version
+ (get-metadata (open-file
+ (string-append (egg-directory name) "/"
+ version "/" name ".egg")
+ "r"))
+ #f)))
+
+(define (guix-name->egg-name name)
+ "Return the CHICKEN egg name corresponding to the Guix package NAME."
+ (if (string-prefix? package-name-prefix name)
+ (substring name (string-length package-name-prefix))
+ name))
+
+(define (guix-package->egg-name package)
+ "Return the CHICKEN egg name of the Guix CHICKEN PACKAGE."
+ (let ((upstream-name (assoc-ref
+ (package-properties package)
+ 'upstream-name))
+ (name (package-name package)))
+ (if upstream-name
+ upstream-name
+ (guix-name->egg-name name))))
+
+(define (egg-package? package)
+ "Check if PACKAGE is an CHICKEN egg package."
+ (and (eq? (build-system-name (package-build-system package)) 'chicken)
+ (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 (port #f) (source #f))
+ "Import CHICKEN egg NAME from and return a @code{<package>} record type for
+the egg, or @code{#f} on failure. PORT is the port for the NAME.egg to read
+from. 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 PORT and SOURCE are specified,
+recursive import will not work."
+ (define egg-content (if port
+ (get-metadata port)
+ (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 (safe-append lst1 lst2)
+ (match (list lst1 lst2)
+ ((#f #f) #f)
+ ((lst1 #f) lst1)
+ ((#f lst2) lst2)
+ (_ (append lst1 lst2))))
+
+ (define egg-home-page
+ (string-append (%eggs-home-page) "/" name))
+
+ (define egg-synopsis
+ (let ((synopsis (assoc-ref egg-content 'synopsis)))
+ (if (list? synopsis)
+ (first synopsis)
+ #f)))
+
+ (define egg-license
+ (let ((license (assoc-ref egg-content 'license)))
+ (if (list? license)
+ ;; Multiple licenses are separated by `/'.
+ (string->license (string-split (first license) #\/))
+ #f)))
+
+ (define (prettify-system-dependency name)
+ (let ((name* (if (symbol? name)
+ (symbol->string name)
+ name)))
+ ;; System dependecies sometimes have spaces and/or upper case
+ ;; letters in them.
+ ;;
+ ;; There will probably still be some weird edge cases.
+ (string-replace-substring (string-downcase name*) " " "")))
+
+ (define (maybe-string->symbol str)
+ (if (string? str) (string->symbol string) str))
+
+ (define (maybe-symbol->string sym)
+ (if (symbol? sym) (symbol->string sym) sym))
+
+ (define* (egg-parse-dependency name #:key (system? #f))
+ (let* ((name* (if (list? name)
+ (first name) ; (name version)
+ name))
+ (name (if system?
+ (prettify-system-dependency name*)
+ (maybe-symbol->string 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 (assoc-ref egg-content
+ 'test-dependencies))
+ (build-dependencies (assoc-ref egg-content
+ 'build-dependencies))
+ (test+build-dependencies (safe-append
+ test-dependencies
+ build-dependencies)))
+ (if (list? 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-license))
+ (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~%"))))))
new file mode 100644
@@ -0,0 +1,90 @@
+;;; 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\"))")
+
+(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 matcher)
+ (define port (open-input-string egg-test))
+ (matcher (egg->guix-package "foo"
+ #:port port
+ #: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://api.call-cc.org/5/doc/foo")
+ ('synopsis "Example egg")
+ ('description #f)
+ ('license (list 'license:gpl3 'license:expat))))
+
+(test-assert "egg->guix-package local file"
+ (eval-test-with-egg-file test-egg-1 match-chicken-foo))
+
+(test-end "egg")