* [PATCH 1/5] import: Add 'elpa' importer @ 2015-06-21 8:28 Federico Beffa 2015-06-21 20:39 ` Alex Kost 0 siblings, 1 reply; 7+ messages in thread From: Federico Beffa @ 2015-06-21 8:28 UTC (permalink / raw) To: Guix-devel [-- Attachment #1: Type: text/plain, Size: 61 bytes --] Hi Guixers, attached a patch to add an ELPA importer. Fede [-- Attachment #2: 0001-import-Add-elpa-importer.patch --] [-- Type: text/x-diff, Size: 19540 bytes --] From 8796b32a1ff8d565c3eb9874cde6a4a14d0b4f3b Mon Sep 17 00:00:00 2001 From: Federico Beffa <beffa@fbengineering.ch> Date: Tue, 16 Jun 2015 10:50:06 +0200 Subject: [PATCH 1/5] import: Add 'elpa' importer. * guix/import/elpa.scm: New file. * guix/scripts/import.scm: Add "elpa" to 'importers'. * guix/scripts/import/elpa.scm: New file. * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. * doc/guix.texi (Invoking guix import): Document it. * tests/elpa.scm: New file. --- Makefile.am | 3 + doc/guix.texi | 27 ++++++ guix/import/elpa.scm | 218 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/elpa.scm | 97 +++++++++++++++++++ tests/elpa.scm | 109 ++++++++++++++++++++++ 6 files changed, 455 insertions(+), 1 deletion(-) create mode 100644 guix/import/elpa.scm create mode 100644 guix/scripts/import/elpa.scm create mode 100644 tests/elpa.scm diff --git a/Makefile.am b/Makefile.am index 2b84467..c027fb3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,6 +95,7 @@ MODULES = \ guix/import/snix.scm \ guix/import/cabal.scm \ guix/import/hackage.scm \ + guix/import/elpa.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -111,6 +112,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/elpa.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix.scm \ @@ -182,6 +184,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 46dccb8..3ca105a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3770,6 +3770,33 @@ package name by a hyphen and a version number as in the following example: @example guix import hackage mtl-2.1.3.1 @end example + +@item elpa +@cindex elpa +Import meta-data from an Emacs ELPA package repository. + +Specific command-line options are: + +@table @code +@item --archive=@var{repo} +@itemx -a @var{repo} +@var{repo} identifies the archive repository to from which to retrive +the information. Currently the supported repositories and their +identifiers are: +@itemize - +@item +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} +identifier. This is the default. + +@item +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the +@code{melpa-stable} identifier. + +@item +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} +identifier. +@end itemize +@end table @end table The structure of the @command{guix import} code is modular. It would be diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm new file mode 100644 index 0000000..589ff8a --- /dev/null +++ b/guix/import/elpa.scm @@ -0,0 +1,218 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:use-module (guix store) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module ((guix utils) #:select (call-with-temporary-output-file + memoize)) + #:export (elpa->guix-package)) + +(define (elpa-dependencies->names deps) + "Convert the list of dependencies from the ELPA format, to a list of string +names." + (map (lambda (d) (symbol->string (first d))) deps)) + +(define (filter-dependencies names) + "Remove the package names included with Emacs from the list of +NAMES (strings)." + (let ((emacs-standard-libraries + '("emacs" "cl-lib"))) + (filter (lambda (d) (not (member d emacs-standard-libraries))) + names))) + +(define (elpa-name->package-name name) + "Given the NAME of an Emacs package, return the corresponding Guix name." + (let ((package-name-prefix "emacs-")) + (if (string-prefix? package-name-prefix name) + (string-downcase name) + (string-append package-name-prefix (string-downcase name))))) + +(define* (elpa-url #:optional (repo "gnu")) + "Retrun the URL of REPO." + (let ((elpa-archives + '(("gnu" . "http://elpa.gnu.org/packages") + ("melpa-stable" . "http://stable.melpa.org/packages") + ("melpa" . "http://melpa.org/packages")))) + (assoc-ref elpa-archives repo))) + +(define* (elpa-fetch-archive #:optional (repo "gnu")) + "Retrive the archive with the list of packages available from REPO." + (let ((url (string-append (elpa-url repo) "/archive-contents"))) + (fetch-and-call-with-input-file url read))) + +;; Fetch URL, store the content in a temporary file and call PROC with that +;; file. +(define fetch-and-call-with-input-file + (memoize + (lambda* (url proc #:optional (err-msg "unavailable")) + (call-with-temporary-output-file + (lambda (temp port) + (or (and (url-fetch url temp) + (call-with-input-file temp proc)) + err-msg)))))) + +(define* (elpa-package-info name #:optional (repo "gnu")) + "Extract the information about the package NAME from the package archieve of +REPO." + (let* ((archive (elpa-fetch-archive repo)) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +;; Object to store information about an ELPA package. +(define-record-type <elpa-package> + (make-elpa-package name version inputs synopsis kind home-page description + source-url) + elpa-package? + (name elpa-package-name) + (version elpa-package-version) + (inputs elpa-package-inputs) + (synopsis elpa-package-synopsis) + (kind elpa-package-kind) + (home-page elpa-package-home-page) + (description elpa-package-description) + (source-url elpa-package-source-url)) + +(set-record-type-printer! <elpa-package> + (lambda (package port) + (format port "#<elpa-package ~a-~a>" + (elpa-package-name package) + (elpa-package-version package)))) + +(define (elpa-version->string elpa-version) + "Convert the package version as used in Emacs package files into a string." + (if (pair? elpa-version) + (let-values (((ms rest) (match elpa-version + ((ms . rest) + (values ms rest))))) + (fold (lambda (n s) (string-append s "." (number->string n))) + (number->string ms) rest)) + #f)) + +(define (lookup-extra alist key) + "Lookup KEY from the ALIST extra package information." + (assq-ref alist key)) + +(define (package-home-page alist) + "Extract the package home-page from ALIST." + (or (lookup-extra alist ':url) "unspecified")) + +(define (nil->empty alist) + "If ALIST is the symbol 'nil return the empty list. Otherwise, return ALIST." + (if (eq? alist 'nil) + '() + alist)) + +(define (package-source-url kind name version repo) + "Return the source URL of the package described the the strings NAME and +VERSION at REPO. KIND is either the symbol 'single or 'tar." + (case kind + ((single) (full-url repo name ".el" version)) + ((tar) (full-url repo name ".tar" version)) + (else + #f))) + +(define* (full-url repo name suffix #:optional (version #f)) + "Return the full URL of the package NAME at REPO and the SUFFIX. Maybe +include VERSION." + (if version + (string-append (elpa-url repo) "/" name "-" version suffix) + (string-append (elpa-url repo) "/" name suffix))) + +(define (fetch-package-description kind name repo) + "Fetch the description of package NAME of type KIND from REPO." + (let ((url (full-url repo name "-readme.txt"))) + (fetch-and-call-with-input-file url read-string))) + +(define* (fetch-elpa-package name #:optional (repo "gnu")) + "Fetch package NAME from REPO." + (let ((pkg (elpa-package-info name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + (fetch-package-description kind name repo) + url))) + (_ #f)))) + +(define* (elpa-package->sexp pkg) + "Return the `package' S-expression for the Emacs package PKG, a record of +type '<elpa-package>'." + + (define name (elpa-package-name pkg)) + + (define version (elpa-package-version pkg)) + + (define source-url (elpa-package-source-url pkg)) + + (define dependencies + (let* ((deps (elpa-package-inputs pkg)) + (names (filter-dependencies (elpa-dependencies->names deps)))) + (map (lambda (n) + (let ((new-n (elpa-name->package-name n))) + (list new-n (list 'unquote (string->symbol new-n))))) + names))) + + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(elpa-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tarball)) + "failed to download package"))))) + (build-system emacs-build-system) + ,@(maybe-inputs 'inputs dependencies) + (home-page ,(elpa-package-home-page pkg)) + (synopsis ,(elpa-package-synopsis pkg)) + (description ,(elpa-package-description pkg)) + (license license:gpl3+)))) + +(define* (elpa->guix-package name #:optional (repo "gnu")) + "Fetch the package NAME from REPO and produce a Guix package S-expression." + (let ((pkg (fetch-elpa-package name repo))) + (and=> pkg elpa-package->sexp))) + +;;; elpa.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 45ce092..d0bdec1 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm new file mode 100644 index 0000000..8754fe2 --- /dev/null +++ b/guix/scripts/import/elpa.scm @@ -0,0 +1,97 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import elpa) + #: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-elpa)) + +\f +;;; +;;; Command-line options. +;;; + +(define %default-options + '((repo . "gnu"))) + +(define (show-help) + (display (_ "Usage: guix import elpa PACKAGE-NAME +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) + (display (_ " + -a ARCHIVE, --archive=ARCHIVE specify the archive repository")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -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 elpa"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'repo arg (alist-delete 'repo result)))) + %standard-import-options)) + +\f +;;; +;;; Entry point. +;;; + +(define (guix-import-elpa . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (unless sexp + (leave (_ "failed to download package '~a'~%") package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; elpa.scm ends here diff --git a/tests/elpa.scm b/tests/elpa.scm new file mode 100644 index 0000000..5d2914b --- /dev/null +++ b/tests/elpa.scm @@ -0,0 +1,109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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-elpa) + #:use-module (guix import elpa) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define elpa-mock-archive + '(1 + (ace-window . + [(0 9 0) + ((avy + (0 2 0))) + "Quickly switch windows." single + ((:url . "https://github.com/abo-abo/ace-window") + (:keywords "window" "location"))]) + (auctex . + [(11 88 6) + nil "Integrated environment for *TeX*" tar + ((:url . "http://www.gnu.org/software/auctex/"))]))) + +(define auctex-readme-mock "This is the AUCTeX description.") + +(define* (elpa-package-info-mock name #:optional (repo "gnu")) + "Simulate retrieval of 'archive-contents' file from REPO and extraction of +information about package NAME. (Function 'elpa-package-info'.)" + (let* ((archive elpa-mock-archive) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +(define elpa-version->string + (@@ (guix import elpa) elpa-version->string)) + +(define package-source-url + (@@ (guix import elpa) package-source-url)) + +(define nil->empty + (@@ (guix import elpa) nil->empty)) + +(define package-home-page + (@@ (guix import elpa) package-home-page)) + +(define make-elpa-package + (@@ (guix import elpa) make-elpa-package)) + +(test-begin "elpa") + +(define (eval-test-with-elpa pkg) + (mock + ;; replace the two fetching functions + ((guix import elpa) fetch-elpa-package + (lambda* (name #:optional (repo "gnu")) + (let ((pkg (elpa-package-info-mock name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + auctex-readme-mock + url))) + (_ #f))))) + (match (elpa->guix-package pkg) + (('package + ('name "emacs-auctex") + ('version "11.88.6") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "http://elpa.gnu.org/packages/auctex-" 'version ".tar")) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'emacs-build-system) + ('home-page "http://www.gnu.org/software/auctex/") + ('synopsis "Integrated environment for *TeX*") + ('description (? string?)) + ('license 'license:gpl3+)) + #t) + (x + (pk 'fail x #f))))) + +(test-assert "elpa->guix-package test 1" + (eval-test-with-elpa "auctex")) + +(test-end "elpa") + +\f +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- 2.2.1 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-21 8:28 [PATCH 1/5] import: Add 'elpa' importer Federico Beffa @ 2015-06-21 20:39 ` Alex Kost 2015-06-24 16:15 ` Federico Beffa 0 siblings, 1 reply; 7+ messages in thread From: Alex Kost @ 2015-06-21 20:39 UTC (permalink / raw) To: Federico Beffa; +Cc: Guix-devel Hi, I've tried this elpa importer and it is great!! I don't have real comments on code, just some nitpicks. Federico Beffa (2015-06-21 11:28 +0300) wrote: > From 8796b32a1ff8d565c3eb9874cde6a4a14d0b4f3b Mon Sep 17 00:00:00 2001 > From: Federico Beffa <beffa@fbengineering.ch> > Date: Tue, 16 Jun 2015 10:50:06 +0200 > Subject: [PATCH 1/5] import: Add 'elpa' importer. > > * guix/import/elpa.scm: New file. > * guix/scripts/import.scm: Add "elpa" to 'importers'. > * guix/scripts/import/elpa.scm: New file. > * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and > 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. AFAIK the convention is to put "(...): ..." on a separate line: * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. [...] > diff --git a/doc/guix.texi b/doc/guix.texi > index 46dccb8..3ca105a 100644 > --- a/doc/guix.texi > +++ b/doc/guix.texi > @@ -3770,6 +3770,33 @@ package name by a hyphen and a version number as in the following example: > @example > guix import hackage mtl-2.1.3.1 > @end example > + > +@item elpa > +@cindex elpa > +Import meta-data from an Emacs ELPA package repository. > + > +Specific command-line options are: > + > +@table @code > +@item --archive=@var{repo} > +@itemx -a @var{repo} > +@var{repo} identifies the archive repository to from which to retrive Redundant "to" (before "from")? And a typo in "retrieve". [...] > +(define* (elpa-package->sexp pkg) There are some trailing spaces in this procedure: > + "Return the `package' S-expression for the Emacs package PKG, a record of > +type '<elpa-package>'." > + here^ > + (define name (elpa-package-name pkg)) > + here^ > + (define version (elpa-package-version pkg)) > + here^ > + (define source-url (elpa-package-source-url pkg)) > + here^ > + (define dependencies > + (let* ((deps (elpa-package-inputs pkg)) > + (names (filter-dependencies (elpa-dependencies->names deps)))) > + (map (lambda (n) > + (let ((new-n (elpa-name->package-name n))) > + (list new-n (list 'unquote (string->symbol new-n))))) > + names))) > + here^ > + (define (maybe-inputs input-type inputs) > + (match inputs > + (() > + '()) > + ((inputs ...) > + (list (list input-type > + (list 'quasiquote inputs)))))) > + here^ [...] > +;;; Command-line options. > +;;; > + > +(define %default-options > + '((repo . "gnu"))) > + > +(define (show-help) > + (display (_ "Usage: guix import elpa PACKAGE-NAME > +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) > + (display (_ " > + -a ARCHIVE, --archive=ARCHIVE specify the archive repository")) I think we don't duplicate an option argument (see "guix package --help" for example): -a, --archive=ARCHIVE specify the archive repository -- Alex ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-21 20:39 ` Alex Kost @ 2015-06-24 16:15 ` Federico Beffa 2015-06-24 21:06 ` Ludovic Courtès 0 siblings, 1 reply; 7+ messages in thread From: Federico Beffa @ 2015-06-24 16:15 UTC (permalink / raw) To: Alex Kost; +Cc: Guix-devel [-- Attachment #1: Type: text/plain, Size: 3131 bytes --] Thanks. On Sun, Jun 21, 2015 at 10:39 PM, Alex Kost <alezost@gmail.com> wrote: > Hi, I've tried this elpa importer and it is great!! > > I don't have real comments on code, just some nitpicks. > > Federico Beffa (2015-06-21 11:28 +0300) wrote: > >> From 8796b32a1ff8d565c3eb9874cde6a4a14d0b4f3b Mon Sep 17 00:00:00 2001 >> From: Federico Beffa <beffa@fbengineering.ch> >> Date: Tue, 16 Jun 2015 10:50:06 +0200 >> Subject: [PATCH 1/5] import: Add 'elpa' importer. >> >> * guix/import/elpa.scm: New file. >> * guix/scripts/import.scm: Add "elpa" to 'importers'. >> * guix/scripts/import/elpa.scm: New file. >> * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and >> 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. > > AFAIK the convention is to put "(...): ..." on a separate line: > > * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and > 'guix/scripts/import/elpa.scm'. > (SCM_TESTS): Add 'tests/elpa.scm'. > > [...] >> diff --git a/doc/guix.texi b/doc/guix.texi >> index 46dccb8..3ca105a 100644 >> --- a/doc/guix.texi >> +++ b/doc/guix.texi >> @@ -3770,6 +3770,33 @@ package name by a hyphen and a version number as in the following example: >> @example >> guix import hackage mtl-2.1.3.1 >> @end example >> + >> +@item elpa >> +@cindex elpa >> +Import meta-data from an Emacs ELPA package repository. >> + >> +Specific command-line options are: >> + >> +@table @code >> +@item --archive=@var{repo} >> +@itemx -a @var{repo} >> +@var{repo} identifies the archive repository to from which to retrive > > Redundant "to" (before "from")? And a typo in "retrieve". > > [...] >> +(define* (elpa-package->sexp pkg) > > There are some trailing spaces in this procedure: > >> + "Return the `package' S-expression for the Emacs package PKG, a record of >> +type '<elpa-package>'." >> + > here^ > >> + (define name (elpa-package-name pkg)) >> + > here^ > >> + (define version (elpa-package-version pkg)) >> + > here^ > >> + (define source-url (elpa-package-source-url pkg)) >> + > here^ > >> + (define dependencies >> + (let* ((deps (elpa-package-inputs pkg)) >> + (names (filter-dependencies (elpa-dependencies->names deps)))) >> + (map (lambda (n) >> + (let ((new-n (elpa-name->package-name n))) >> + (list new-n (list 'unquote (string->symbol new-n))))) >> + names))) >> + > here^ > >> + (define (maybe-inputs input-type inputs) >> + (match inputs >> + (() >> + '()) >> + ((inputs ...) >> + (list (list input-type >> + (list 'quasiquote inputs)))))) >> + > here^ > > [...] >> +;;; Command-line options. >> +;;; >> + >> +(define %default-options >> + '((repo . "gnu"))) >> + >> +(define (show-help) >> + (display (_ "Usage: guix import elpa PACKAGE-NAME >> +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) >> + (display (_ " >> + -a ARCHIVE, --archive=ARCHIVE specify the archive repository")) > > I think we don't duplicate an option argument (see "guix package --help" > for example): > > -a, --archive=ARCHIVE specify the archive repository > > -- > Alex [-- Attachment #2: 0001-import-Add-elpa-importer.patch --] [-- Type: text/x-diff, Size: 19524 bytes --] From 595befd0fb88ae00d405a727efb55b9fa456e549 Mon Sep 17 00:00:00 2001 From: Federico Beffa <beffa@fbengineering.ch> Date: Tue, 16 Jun 2015 10:50:06 +0200 Subject: [PATCH 1/5] import: Add 'elpa' importer. * guix/import/elpa.scm: New file. * guix/scripts/import.scm: Add "elpa" to 'importers'. * guix/scripts/import/elpa.scm: New file. * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. * doc/guix.texi (Invoking guix import): Document it. * tests/elpa.scm: New file. --- Makefile.am | 3 + doc/guix.texi | 27 ++++++ guix/import/elpa.scm | 218 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/elpa.scm | 97 +++++++++++++++++++ tests/elpa.scm | 109 ++++++++++++++++++++++ 6 files changed, 455 insertions(+), 1 deletion(-) create mode 100644 guix/import/elpa.scm create mode 100644 guix/scripts/import/elpa.scm create mode 100644 tests/elpa.scm diff --git a/Makefile.am b/Makefile.am index 2b84467..c027fb3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,6 +95,7 @@ MODULES = \ guix/import/snix.scm \ guix/import/cabal.scm \ guix/import/hackage.scm \ + guix/import/elpa.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -111,6 +112,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/elpa.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix.scm \ @@ -182,6 +184,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 46dccb8..f8756ed 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3770,6 +3770,33 @@ package name by a hyphen and a version number as in the following example: @example guix import hackage mtl-2.1.3.1 @end example + +@item elpa +@cindex elpa +Import meta-data from an Emacs ELPA package repository. + +Specific command-line options are: + +@table @code +@item --archive=@var{repo} +@itemx -a @var{repo} +@var{repo} identifies the archive repository from which to retrieve the +information. Currently the supported repositories and their identifiers +are: +@itemize - +@item +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} +identifier. This is the default. + +@item +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the +@code{melpa-stable} identifier. + +@item +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} +identifier. +@end itemize +@end table @end table The structure of the @command{guix import} code is modular. It would be diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm new file mode 100644 index 0000000..fe1f6eb --- /dev/null +++ b/guix/import/elpa.scm @@ -0,0 +1,218 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:use-module (guix store) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module ((guix utils) #:select (call-with-temporary-output-file + memoize)) + #:export (elpa->guix-package)) + +(define (elpa-dependencies->names deps) + "Convert the list of dependencies from the ELPA format, to a list of string +names." + (map (lambda (d) (symbol->string (first d))) deps)) + +(define (filter-dependencies names) + "Remove the package names included with Emacs from the list of +NAMES (strings)." + (let ((emacs-standard-libraries + '("emacs" "cl-lib"))) + (filter (lambda (d) (not (member d emacs-standard-libraries))) + names))) + +(define (elpa-name->package-name name) + "Given the NAME of an Emacs package, return the corresponding Guix name." + (let ((package-name-prefix "emacs-")) + (if (string-prefix? package-name-prefix name) + (string-downcase name) + (string-append package-name-prefix (string-downcase name))))) + +(define* (elpa-url #:optional (repo "gnu")) + "Retrun the URL of REPO." + (let ((elpa-archives + '(("gnu" . "http://elpa.gnu.org/packages") + ("melpa-stable" . "http://stable.melpa.org/packages") + ("melpa" . "http://melpa.org/packages")))) + (assoc-ref elpa-archives repo))) + +(define* (elpa-fetch-archive #:optional (repo "gnu")) + "Retrive the archive with the list of packages available from REPO." + (let ((url (string-append (elpa-url repo) "/archive-contents"))) + (fetch-and-call-with-input-file url read))) + +;; Fetch URL, store the content in a temporary file and call PROC with that +;; file. +(define fetch-and-call-with-input-file + (memoize + (lambda* (url proc #:optional (err-msg "unavailable")) + (call-with-temporary-output-file + (lambda (temp port) + (or (and (url-fetch url temp) + (call-with-input-file temp proc)) + err-msg)))))) + +(define* (elpa-package-info name #:optional (repo "gnu")) + "Extract the information about the package NAME from the package archieve of +REPO." + (let* ((archive (elpa-fetch-archive repo)) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +;; Object to store information about an ELPA package. +(define-record-type <elpa-package> + (make-elpa-package name version inputs synopsis kind home-page description + source-url) + elpa-package? + (name elpa-package-name) + (version elpa-package-version) + (inputs elpa-package-inputs) + (synopsis elpa-package-synopsis) + (kind elpa-package-kind) + (home-page elpa-package-home-page) + (description elpa-package-description) + (source-url elpa-package-source-url)) + +(set-record-type-printer! <elpa-package> + (lambda (package port) + (format port "#<elpa-package ~a-~a>" + (elpa-package-name package) + (elpa-package-version package)))) + +(define (elpa-version->string elpa-version) + "Convert the package version as used in Emacs package files into a string." + (if (pair? elpa-version) + (let-values (((ms rest) (match elpa-version + ((ms . rest) + (values ms rest))))) + (fold (lambda (n s) (string-append s "." (number->string n))) + (number->string ms) rest)) + #f)) + +(define (lookup-extra alist key) + "Lookup KEY from the ALIST extra package information." + (assq-ref alist key)) + +(define (package-home-page alist) + "Extract the package home-page from ALIST." + (or (lookup-extra alist ':url) "unspecified")) + +(define (nil->empty alist) + "If ALIST is the symbol 'nil return the empty list. Otherwise, return ALIST." + (if (eq? alist 'nil) + '() + alist)) + +(define (package-source-url kind name version repo) + "Return the source URL of the package described the the strings NAME and +VERSION at REPO. KIND is either the symbol 'single or 'tar." + (case kind + ((single) (full-url repo name ".el" version)) + ((tar) (full-url repo name ".tar" version)) + (else + #f))) + +(define* (full-url repo name suffix #:optional (version #f)) + "Return the full URL of the package NAME at REPO and the SUFFIX. Maybe +include VERSION." + (if version + (string-append (elpa-url repo) "/" name "-" version suffix) + (string-append (elpa-url repo) "/" name suffix))) + +(define (fetch-package-description kind name repo) + "Fetch the description of package NAME of type KIND from REPO." + (let ((url (full-url repo name "-readme.txt"))) + (fetch-and-call-with-input-file url read-string))) + +(define* (fetch-elpa-package name #:optional (repo "gnu")) + "Fetch package NAME from REPO." + (let ((pkg (elpa-package-info name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + (fetch-package-description kind name repo) + url))) + (_ #f)))) + +(define* (elpa-package->sexp pkg) + "Return the `package' S-expression for the Emacs package PKG, a record of +type '<elpa-package>'." + + (define name (elpa-package-name pkg)) + + (define version (elpa-package-version pkg)) + + (define source-url (elpa-package-source-url pkg)) + + (define dependencies + (let* ((deps (elpa-package-inputs pkg)) + (names (filter-dependencies (elpa-dependencies->names deps)))) + (map (lambda (n) + (let ((new-n (elpa-name->package-name n))) + (list new-n (list 'unquote (string->symbol new-n))))) + names))) + + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(elpa-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tarball)) + "failed to download package"))))) + (build-system emacs-build-system) + ,@(maybe-inputs 'inputs dependencies) + (home-page ,(elpa-package-home-page pkg)) + (synopsis ,(elpa-package-synopsis pkg)) + (description ,(elpa-package-description pkg)) + (license license:gpl3+)))) + +(define* (elpa->guix-package name #:optional (repo "gnu")) + "Fetch the package NAME from REPO and produce a Guix package S-expression." + (let ((pkg (fetch-elpa-package name repo))) + (and=> pkg elpa-package->sexp))) + +;;; elpa.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 45ce092..d0bdec1 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm new file mode 100644 index 0000000..d6f1bac --- /dev/null +++ b/guix/scripts/import/elpa.scm @@ -0,0 +1,97 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import elpa) + #: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-elpa)) + +\f +;;; +;;; Command-line options. +;;; + +(define %default-options + '((repo . "gnu"))) + +(define (show-help) + (display (_ "Usage: guix import elpa PACKAGE-NAME +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) + (display (_ " + -a, --archive=ARCHIVE specify the archive repository")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -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 elpa"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'repo arg (alist-delete 'repo result)))) + %standard-import-options)) + +\f +;;; +;;; Entry point. +;;; + +(define (guix-import-elpa . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (unless sexp + (leave (_ "failed to download package '~a'~%") package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; elpa.scm ends here diff --git a/tests/elpa.scm b/tests/elpa.scm new file mode 100644 index 0000000..5d2914b --- /dev/null +++ b/tests/elpa.scm @@ -0,0 +1,109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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-elpa) + #:use-module (guix import elpa) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define elpa-mock-archive + '(1 + (ace-window . + [(0 9 0) + ((avy + (0 2 0))) + "Quickly switch windows." single + ((:url . "https://github.com/abo-abo/ace-window") + (:keywords "window" "location"))]) + (auctex . + [(11 88 6) + nil "Integrated environment for *TeX*" tar + ((:url . "http://www.gnu.org/software/auctex/"))]))) + +(define auctex-readme-mock "This is the AUCTeX description.") + +(define* (elpa-package-info-mock name #:optional (repo "gnu")) + "Simulate retrieval of 'archive-contents' file from REPO and extraction of +information about package NAME. (Function 'elpa-package-info'.)" + (let* ((archive elpa-mock-archive) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +(define elpa-version->string + (@@ (guix import elpa) elpa-version->string)) + +(define package-source-url + (@@ (guix import elpa) package-source-url)) + +(define nil->empty + (@@ (guix import elpa) nil->empty)) + +(define package-home-page + (@@ (guix import elpa) package-home-page)) + +(define make-elpa-package + (@@ (guix import elpa) make-elpa-package)) + +(test-begin "elpa") + +(define (eval-test-with-elpa pkg) + (mock + ;; replace the two fetching functions + ((guix import elpa) fetch-elpa-package + (lambda* (name #:optional (repo "gnu")) + (let ((pkg (elpa-package-info-mock name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + auctex-readme-mock + url))) + (_ #f))))) + (match (elpa->guix-package pkg) + (('package + ('name "emacs-auctex") + ('version "11.88.6") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "http://elpa.gnu.org/packages/auctex-" 'version ".tar")) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'emacs-build-system) + ('home-page "http://www.gnu.org/software/auctex/") + ('synopsis "Integrated environment for *TeX*") + ('description (? string?)) + ('license 'license:gpl3+)) + #t) + (x + (pk 'fail x #f))))) + +(test-assert "elpa->guix-package test 1" + (eval-test-with-elpa "auctex")) + +(test-end "elpa") + +\f +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- 2.2.1 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-24 16:15 ` Federico Beffa @ 2015-06-24 21:06 ` Ludovic Courtès 2015-06-25 18:33 ` Federico Beffa 0 siblings, 1 reply; 7+ messages in thread From: Ludovic Courtès @ 2015-06-24 21:06 UTC (permalink / raw) To: Federico Beffa; +Cc: Guix-devel, Alex Kost Federico Beffa <beffa@ieee.org> skribis: > From 595befd0fb88ae00d405a727efb55b9fa456e549 Mon Sep 17 00:00:00 2001 > From: Federico Beffa <beffa@fbengineering.ch> > Date: Tue, 16 Jun 2015 10:50:06 +0200 > Subject: [PATCH 1/5] import: Add 'elpa' importer. > > * guix/import/elpa.scm: New file. > * guix/scripts/import.scm: Add "elpa" to 'importers'. > * guix/scripts/import/elpa.scm: New file. > * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and > 'guix/scripts/import/elpa.scm'. > (SCM_TESTS): Add 'tests/elpa.scm'. > * doc/guix.texi (Invoking guix import): Document it. > * tests/elpa.scm: New file. This looks nice! (And you were fast!) Below are some comments essentially nitpicking about the style. > --- a/doc/guix.texi > +++ b/doc/guix.texi > @@ -3770,6 +3770,33 @@ package name by a hyphen and a version number as in the following example: > @example > guix import hackage mtl-2.1.3.1 > @end example > + > +@item elpa > +@cindex elpa > +Import meta-data from an Emacs ELPA package repository. Rather: from an Emacs Lisp Package Archive (ELPA) package repository (@pxref{Packages,,, emacs, The GNU Emacs Manual}). > +Specific command-line options are: > + > +@table @code > +@item --archive=@var{repo} > +@itemx -a @var{repo} > +@var{repo} identifies the archive repository from which to retrieve the > +information. Currently the supported repositories and their identifiers > +are: > +@itemize - > +@item > +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} > +identifier. This is the default. > + > +@item > +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the > +@code{melpa-stable} identifier. > + > +@item > +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} > +identifier. > +@end itemize Perhaps REPO could also be a URL, in addition to one of these identifiers? > +(define (elpa-dependencies->names deps) > + "Convert the list of dependencies from the ELPA format, to a list of string > +names." What about: Convert DEPS, a list of foobars à la ELPA, to a list of package names as strings. > + (map (lambda (d) (symbol->string (first d))) deps)) (match deps (((names _ ...) ...) (map symbol->string names))) > +(define (filter-dependencies names) > + "Remove the package names included with Emacs from the list of > +NAMES (strings)." > + (let ((emacs-standard-libraries > + '("emacs" "cl-lib"))) > + (filter (lambda (d) (not (member d emacs-standard-libraries))) > + names))) In general I think it’s best to give the predicate a name, and to not define a ‘filter-xxx’ or ‘remove-xxx’ function. So: (define emacs-standard-library? (let ((libs '("emacs" "cl-lib"))) (lambda (lib) "Return true if ..." (member lib libs)))) and then: (filter emacs-standard-library? names) wherever needed. > +(define* (elpa-url #:optional (repo "gnu")) I would rather use a symbol for REPO. > +;; Fetch URL, store the content in a temporary file and call PROC with that > +;; file. > +(define fetch-and-call-with-input-file > + (memoize > + (lambda* (url proc #:optional (err-msg "unavailable")) > + (call-with-temporary-output-file > + (lambda (temp port) > + (or (and (url-fetch url temp) > + (call-with-input-file temp proc)) > + err-msg)))))) Make the comment a docstring below ‘lambda*’. I would call it ‘call-with-downloaded-file’ for instance. But then memoization should be moved elsewhere, because that’s not one would expect from a procedure with this name. The return value must also be documented. Returning an error message is not an option IMO, because the caller could hardly distinguish it from a “normal” return value, and because that’s a very unusual convention. Probably an error condition should be raised? > +(define* (elpa-package-info name #:optional (repo "gnu")) > + "Extract the information about the package NAME from the package archieve of > +REPO." > + (let* ((archive (elpa-fetch-archive repo)) > + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) > + (cdr archive)))) > + (if (pair? info) (first info) #f))) Give the predicate a name, and rather use ‘match’. > +(define (lookup-extra alist key) > + "Lookup KEY from the ALIST extra package information." > + (assq-ref alist key)) Use ‘assq-ref’ directly. > +(define (package-home-page alist) > + "Extract the package home-page from ALIST." > + (or (lookup-extra alist ':url) "unspecified")) Maybe use the ‘elpa-package’ prefix instead of ‘package’ for procedures like this one that expect an ELPA-package-as-an-alist? > +(define (nil->empty alist) > + "If ALIST is the symbol 'nil return the empty list. Otherwise, return ALIST." Rather ‘ensure-list’. Thank you! Ludo’. ^ permalink raw reply [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-24 21:06 ` Ludovic Courtès @ 2015-06-25 18:33 ` Federico Beffa 2015-06-27 8:13 ` Federico Beffa 0 siblings, 1 reply; 7+ messages in thread From: Federico Beffa @ 2015-06-25 18:33 UTC (permalink / raw) To: Ludovic Courtès; +Cc: Guix-devel, Alex Kost [-- Attachment #1: Type: text/plain, Size: 2233 bytes --] Thanks for the review! I've made the suggested changes, except for the comments below. On Wed, Jun 24, 2015 at 11:06 PM, Ludovic Courtès <ludo@gnu.org> wrote: > Federico Beffa <beffa@ieee.org> skribis: >> +Specific command-line options are: >> + >> +@table @code >> +@item --archive=@var{repo} >> +@itemx -a @var{repo} >> +@var{repo} identifies the archive repository from which to retrieve the >> +information. Currently the supported repositories and their identifiers >> +are: >> +@itemize - >> +@item >> +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} >> +identifier. This is the default. >> + >> +@item >> +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the >> +@code{melpa-stable} identifier. >> + >> +@item >> +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} >> +identifier. >> +@end itemize > > Perhaps REPO could also be a URL, in addition to one of these identifiers? Yeah, perhaps later. >> +;; Fetch URL, store the content in a temporary file and call PROC with that >> +;; file. >> +(define fetch-and-call-with-input-file >> + (memoize >> + (lambda* (url proc #:optional (err-msg "unavailable")) >> + (call-with-temporary-output-file >> + (lambda (temp port) >> + (or (and (url-fetch url temp) >> + (call-with-input-file temp proc)) >> + err-msg)))))) > > Make the comment a docstring below ‘lambda*’. > > I would call it ‘call-with-downloaded-file’ for instance. But then > memoization should be moved elsewhere, because that’s not one would > expect from a procedure with this name. I've deleted memoization because it's not really helping in any way here. It was helpful for experimenting in the REPL... >> +(define (package-home-page alist) >> + "Extract the package home-page from ALIST." >> + (or (lookup-extra alist ':url) "unspecified")) > > Maybe use the ‘elpa-package’ prefix instead of ‘package’ for procedures > like this one that expect an ELPA-package-as-an-alist? 'elpa-package-home-page' is already taken by a field accessor of the record <elpa-package>. So, I've left it alone. Thanks, Fede [-- Attachment #2: 0001-import-Add-elpa-importer.patch --] [-- Type: text/x-diff, Size: 20212 bytes --] From 4d67233593a16bd2d213304202a3c2e87aed7797 Mon Sep 17 00:00:00 2001 From: Federico Beffa <beffa@fbengineering.ch> Date: Tue, 16 Jun 2015 10:50:06 +0200 Subject: [PATCH 1/5] import: Add 'elpa' importer. * guix/import/elpa.scm: New file. * guix/scripts/import.scm: Add "elpa" to 'importers'. * guix/scripts/import/elpa.scm: New file. * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. * doc/guix.texi (Invoking guix import): Document it. * tests/elpa.scm: New file. --- Makefile.am | 3 + doc/guix.texi | 28 ++++++ guix/import/elpa.scm | 230 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/elpa.scm | 98 ++++++++++++++++++ tests/elpa.scm | 109 ++++++++++++++++++++ 6 files changed, 469 insertions(+), 1 deletion(-) create mode 100644 guix/import/elpa.scm create mode 100644 guix/scripts/import/elpa.scm create mode 100644 tests/elpa.scm diff --git a/Makefile.am b/Makefile.am index 2b84467..c027fb3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,6 +95,7 @@ MODULES = \ guix/import/snix.scm \ guix/import/cabal.scm \ guix/import/hackage.scm \ + guix/import/elpa.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -111,6 +112,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/elpa.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix.scm \ @@ -182,6 +184,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 46dccb8..9ef6021 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3770,6 +3770,34 @@ package name by a hyphen and a version number as in the following example: @example guix import hackage mtl-2.1.3.1 @end example + +@item elpa +@cindex elpa +Import meta-data from an Emacs Lisp Package Archive (ELPA) package +repository (@pxref{Packages,,, emacs, The GNU Emacs Manual}). + +Specific command-line options are: + +@table @code +@item --archive=@var{repo} +@itemx -a @var{repo} +@var{repo} identifies the archive repository from which to retrieve the +information. Currently the supported repositories and their identifiers +are: +@itemize - +@item +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} +identifier. This is the default. + +@item +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the +@code{melpa-stable} identifier. + +@item +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} +identifier. +@end itemize +@end table @end table The structure of the @command{guix import} code is modular. It would be diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm new file mode 100644 index 0000000..e8bf47d --- /dev/null +++ b/guix/import/elpa.scm @@ -0,0 +1,230 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:use-module (guix store) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module ((guix utils) #:select (call-with-temporary-output-file + memoize)) + #:export (elpa->guix-package)) + +(define (elpa-dependencies->names deps) + "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of +package names as strings" + (match deps + (((names _ ...) ...) + (map symbol->string names)))) + +(define emacs-standard-library? + (let ((libs '("emacs" "cl-lib"))) + (lambda (lib) + "Return true if LIB is part of Emacs itself. The check is not +exhaustive and only attempts to recognize a subset of packages which in the +past were distributed separately from Emacs." + (member lib libs)))) + +(define (filter-dependencies names) + "Remove the package names included with Emacs from the list of +NAMES (strings)." + (filter emacs-standard-library? names)) + +(define (elpa-name->package-name name) + "Given the NAME of an Emacs package, return the corresponding Guix name." + (let ((package-name-prefix "emacs-")) + (if (string-prefix? package-name-prefix name) + (string-downcase name) + (string-append package-name-prefix (string-downcase name))))) + +(define* (elpa-url #:optional (repo 'gnu)) + "Retrun the URL of REPO." + (let ((elpa-archives + '((gnu . "http://elpa.gnu.org/packages") + (melpa-stable . "http://stable.melpa.org/packages") + (melpa . "http://melpa.org/packages")))) + (assq-ref elpa-archives repo))) + +(define* (elpa-fetch-archive #:optional (repo 'gnu)) + "Retrive the archive with the list of packages available from REPO." + (let ((url (and=> (elpa-url repo) + (cut string-append <> "/archive-contents")))) + (if url + (call-with-downloaded-file url read) + (error "Currently not supported:" repo)))) + +(define* (call-with-downloaded-file url proc + #:optional (err-msg "unavailable")) + "Fetch URL, store the content in a temporary file and call PROC with that +file. Returns the value returned by PROC." + (call-with-temporary-output-file + (lambda (temp port) + (or (and (url-fetch url temp) + (call-with-input-file temp proc)) + (error err-msg url))))) + +(define (is-elpa-package? name elpa-pkg-spec) + "Return true if the string NAME corresponds to the name of the package +defined by ELPA-PKG-SPEC, a package specification as in an archive +'archive-contents' file." + (eq? (first elpa-pkg-spec) (string->symbol name))) + +(define* (elpa-package-info name #:optional (repo 'gnu)) + "Extract the information about the package NAME from the package archieve of +REPO." + (let* ((archive (elpa-fetch-archive repo)) + (pkgs (match archive ((version pkg-spec ...) pkg-spec))) + (info (filter (cut is-elpa-package? name <>) pkgs))) + (if (pair? info) (first info) #f))) + +;; Object to store information about an ELPA package. +(define-record-type <elpa-package> + (make-elpa-package name version inputs synopsis kind home-page description + source-url) + elpa-package? + (name elpa-package-name) + (version elpa-package-version) + (inputs elpa-package-inputs) + (synopsis elpa-package-synopsis) + (kind elpa-package-kind) + (home-page elpa-package-home-page) + (description elpa-package-description) + (source-url elpa-package-source-url)) + +(set-record-type-printer! <elpa-package> + (lambda (package port) + (format port "#<elpa-package ~a-~a>" + (elpa-package-name package) + (elpa-package-version package)))) + +(define (elpa-version->string elpa-version) + "Convert the package version as used in Emacs package files into a string." + (if (pair? elpa-version) + (let-values (((ms rest) (match elpa-version + ((ms . rest) + (values ms rest))))) + (fold (lambda (n s) (string-append s "." (number->string n))) + (number->string ms) rest)) + #f)) + +(define (package-home-page alist) + "Extract the package home-page from ALIST." + (or (assq-ref alist ':url) "unspecified")) + +(define (ensure-list alist) + "If ALIST is the symbol 'nil return the empty list. Otherwise, return ALIST." + (if (eq? alist 'nil) + '() + alist)) + +(define (package-source-url kind name version repo) + "Return the source URL of the package described the the strings NAME and +VERSION at REPO. KIND is either the symbol 'single or 'tar." + (case kind + ((single) (full-url repo name ".el" version)) + ((tar) (full-url repo name ".tar" version)) + (else + #f))) + +(define* (full-url repo name suffix #:optional (version #f)) + "Return the full URL of the package NAME at REPO and the SUFFIX. Maybe +include VERSION." + (if version + (string-append (elpa-url repo) "/" name "-" version suffix) + (string-append (elpa-url repo) "/" name suffix))) + +(define (fetch-package-description kind name repo) + "Fetch the description of package NAME of type KIND from REPO." + (let ((url (full-url repo name "-readme.txt"))) + (call-with-downloaded-file url read-string))) + +(define* (fetch-elpa-package name #:optional (repo 'gnu)) + "Fetch package NAME from REPO." + (let ((pkg (elpa-package-info name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (ensure-list reqs) synopsis kind + (package-home-page (first rest)) + (fetch-package-description kind name repo) + url))) + (_ #f)))) + +(define* (elpa-package->sexp pkg) + "Return the `package' S-expression for the Emacs package PKG, a record of +type '<elpa-package>'." + + (define name (elpa-package-name pkg)) + + (define version (elpa-package-version pkg)) + + (define source-url (elpa-package-source-url pkg)) + + (define dependencies + (let* ((deps (elpa-package-inputs pkg)) + (names (filter-dependencies (elpa-dependencies->names deps)))) + (map (lambda (n) + (let ((new-n (elpa-name->package-name n))) + (list new-n (list 'unquote (string->symbol new-n))))) + names))) + + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(elpa-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tarball)) + "failed to download package"))))) + (build-system emacs-build-system) + ,@(maybe-inputs 'inputs dependencies) + (home-page ,(elpa-package-home-page pkg)) + (synopsis ,(elpa-package-synopsis pkg)) + (description ,(elpa-package-description pkg)) + (license license:gpl3+)))) + +(define* (elpa->guix-package name #:optional (repo 'gnu)) + "Fetch the package NAME from REPO and produce a Guix package S-expression." + (let ((pkg (fetch-elpa-package name repo))) + (and=> pkg elpa-package->sexp))) + +;;; elpa.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 45ce092..d0bdec1 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm new file mode 100644 index 0000000..9034eb7 --- /dev/null +++ b/guix/scripts/import/elpa.scm @@ -0,0 +1,98 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import elpa) + #: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-elpa)) + +\f +;;; +;;; Command-line options. +;;; + +(define %default-options + '((repo . 'gnu))) + +(define (show-help) + (display (_ "Usage: guix import elpa PACKAGE-NAME +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) + (display (_ " + -a, --archive=ARCHIVE specify the archive repository")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -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 elpa"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'repo (string->symbol arg) + (alist-delete 'repo result)))) + %standard-import-options)) + +\f +;;; +;;; Entry point. +;;; + +(define (guix-import-elpa . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (unless sexp + (leave (_ "failed to download package '~a'~%") package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; elpa.scm ends here diff --git a/tests/elpa.scm b/tests/elpa.scm new file mode 100644 index 0000000..5d2914b --- /dev/null +++ b/tests/elpa.scm @@ -0,0 +1,109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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-elpa) + #:use-module (guix import elpa) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define elpa-mock-archive + '(1 + (ace-window . + [(0 9 0) + ((avy + (0 2 0))) + "Quickly switch windows." single + ((:url . "https://github.com/abo-abo/ace-window") + (:keywords "window" "location"))]) + (auctex . + [(11 88 6) + nil "Integrated environment for *TeX*" tar + ((:url . "http://www.gnu.org/software/auctex/"))]))) + +(define auctex-readme-mock "This is the AUCTeX description.") + +(define* (elpa-package-info-mock name #:optional (repo "gnu")) + "Simulate retrieval of 'archive-contents' file from REPO and extraction of +information about package NAME. (Function 'elpa-package-info'.)" + (let* ((archive elpa-mock-archive) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +(define elpa-version->string + (@@ (guix import elpa) elpa-version->string)) + +(define package-source-url + (@@ (guix import elpa) package-source-url)) + +(define nil->empty + (@@ (guix import elpa) nil->empty)) + +(define package-home-page + (@@ (guix import elpa) package-home-page)) + +(define make-elpa-package + (@@ (guix import elpa) make-elpa-package)) + +(test-begin "elpa") + +(define (eval-test-with-elpa pkg) + (mock + ;; replace the two fetching functions + ((guix import elpa) fetch-elpa-package + (lambda* (name #:optional (repo "gnu")) + (let ((pkg (elpa-package-info-mock name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + auctex-readme-mock + url))) + (_ #f))))) + (match (elpa->guix-package pkg) + (('package + ('name "emacs-auctex") + ('version "11.88.6") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "http://elpa.gnu.org/packages/auctex-" 'version ".tar")) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'emacs-build-system) + ('home-page "http://www.gnu.org/software/auctex/") + ('synopsis "Integrated environment for *TeX*") + ('description (? string?)) + ('license 'license:gpl3+)) + #t) + (x + (pk 'fail x #f))))) + +(test-assert "elpa->guix-package test 1" + (eval-test-with-elpa "auctex")) + +(test-end "elpa") + +\f +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- 2.2.1 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-25 18:33 ` Federico Beffa @ 2015-06-27 8:13 ` Federico Beffa 2015-06-27 10:08 ` Ludovic Courtès 0 siblings, 1 reply; 7+ messages in thread From: Federico Beffa @ 2015-06-27 8:13 UTC (permalink / raw) To: Ludovic Courtès; +Cc: Guix-devel, Alex Kost [-- Attachment #1: Type: text/plain, Size: 2455 bytes --] Oops, I've noticed that an unsupported repo was not handled gracefully. On Thu, Jun 25, 2015 at 8:33 PM, Federico Beffa <beffa@ieee.org> wrote: > Thanks for the review! > > I've made the suggested changes, except for the comments below. > > On Wed, Jun 24, 2015 at 11:06 PM, Ludovic Courtès <ludo@gnu.org> wrote: >> Federico Beffa <beffa@ieee.org> skribis: >>> +Specific command-line options are: >>> + >>> +@table @code >>> +@item --archive=@var{repo} >>> +@itemx -a @var{repo} >>> +@var{repo} identifies the archive repository from which to retrieve the >>> +information. Currently the supported repositories and their identifiers >>> +are: >>> +@itemize - >>> +@item >>> +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} >>> +identifier. This is the default. >>> + >>> +@item >>> +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the >>> +@code{melpa-stable} identifier. >>> + >>> +@item >>> +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} >>> +identifier. >>> +@end itemize >> >> Perhaps REPO could also be a URL, in addition to one of these identifiers? > > Yeah, perhaps later. > >>> +;; Fetch URL, store the content in a temporary file and call PROC with that >>> +;; file. >>> +(define fetch-and-call-with-input-file >>> + (memoize >>> + (lambda* (url proc #:optional (err-msg "unavailable")) >>> + (call-with-temporary-output-file >>> + (lambda (temp port) >>> + (or (and (url-fetch url temp) >>> + (call-with-input-file temp proc)) >>> + err-msg)))))) >> >> Make the comment a docstring below ‘lambda*’. >> >> I would call it ‘call-with-downloaded-file’ for instance. But then >> memoization should be moved elsewhere, because that’s not one would >> expect from a procedure with this name. > > I've deleted memoization because it's not really helping in any way > here. It was helpful for experimenting in the REPL... > >>> +(define (package-home-page alist) >>> + "Extract the package home-page from ALIST." >>> + (or (lookup-extra alist ':url) "unspecified")) >> >> Maybe use the ‘elpa-package’ prefix instead of ‘package’ for procedures >> like this one that expect an ELPA-package-as-an-alist? > > 'elpa-package-home-page' is already taken by a field accessor of the > record <elpa-package>. So, I've left it alone. > > Thanks, > Fede [-- Attachment #2: 0001-import-Add-elpa-importer.patch --] [-- Type: text/x-diff, Size: 20247 bytes --] From 56c460213d76ff2b88fd771b48997c3e03200234 Mon Sep 17 00:00:00 2001 From: Federico Beffa <beffa@fbengineering.ch> Date: Tue, 16 Jun 2015 10:50:06 +0200 Subject: [PATCH 1/6] import: Add 'elpa' importer. * guix/import/elpa.scm: New file. * guix/scripts/import.scm: Add "elpa" to 'importers'. * guix/scripts/import/elpa.scm: New file. * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and 'guix/scripts/import/elpa.scm'. (SCM_TESTS): Add 'tests/elpa.scm'. * doc/guix.texi (Invoking guix import): Document it. * tests/elpa.scm: New file. --- Makefile.am | 3 + doc/guix.texi | 28 ++++++ guix/import/elpa.scm | 231 +++++++++++++++++++++++++++++++++++++++++++ guix/scripts/import.scm | 2 +- guix/scripts/import/elpa.scm | 98 ++++++++++++++++++ tests/elpa.scm | 109 ++++++++++++++++++++ 6 files changed, 470 insertions(+), 1 deletion(-) create mode 100644 guix/import/elpa.scm create mode 100644 guix/scripts/import/elpa.scm create mode 100644 tests/elpa.scm diff --git a/Makefile.am b/Makefile.am index 2b84467..c027fb3 100644 --- a/Makefile.am +++ b/Makefile.am @@ -95,6 +95,7 @@ MODULES = \ guix/import/snix.scm \ guix/import/cabal.scm \ guix/import/hackage.scm \ + guix/import/elpa.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -111,6 +112,7 @@ MODULES = \ guix/scripts/import/gnu.scm \ guix/scripts/import/nix.scm \ guix/scripts/import/hackage.scm \ + guix/scripts/import/elpa.scm \ guix/scripts/environment.scm \ guix/scripts/publish.scm \ guix.scm \ @@ -182,6 +184,7 @@ SCM_TESTS = \ tests/packages.scm \ tests/snix.scm \ tests/hackage.scm \ + tests/elpa.scm \ tests/store.scm \ tests/monads.scm \ tests/gexp.scm \ diff --git a/doc/guix.texi b/doc/guix.texi index 46dccb8..9ef6021 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3770,6 +3770,34 @@ package name by a hyphen and a version number as in the following example: @example guix import hackage mtl-2.1.3.1 @end example + +@item elpa +@cindex elpa +Import meta-data from an Emacs Lisp Package Archive (ELPA) package +repository (@pxref{Packages,,, emacs, The GNU Emacs Manual}). + +Specific command-line options are: + +@table @code +@item --archive=@var{repo} +@itemx -a @var{repo} +@var{repo} identifies the archive repository from which to retrieve the +information. Currently the supported repositories and their identifiers +are: +@itemize - +@item +@uref{"http://elpa.gnu.org/packages", GNU}, selected by the @code{gnu} +identifier. This is the default. + +@item +@uref{"http://stable.melpa.org/packages", MELPA-Stable}, selected by the +@code{melpa-stable} identifier. + +@item +@uref{"http://melpa.org/packages", MELPA}, selected by the @code{melpa} +identifier. +@end itemize +@end table @end table The structure of the @command{guix import} code is modular. It would be diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm new file mode 100644 index 0000000..4e0f239 --- /dev/null +++ b/guix/import/elpa.scm @@ -0,0 +1,231 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (ice-9 match) + #:use-module (ice-9 rdelim) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) + #:use-module ((guix download) #:select (download-to-store)) + #:use-module (guix import utils) + #:use-module (guix store) + #:use-module (guix ui) + #:use-module (guix hash) + #:use-module (guix base32) + #:use-module ((guix utils) #:select (call-with-temporary-output-file + memoize)) + #:export (elpa->guix-package)) + +(define (elpa-dependencies->names deps) + "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of +package names as strings" + (match deps + (((names _ ...) ...) + (map symbol->string names)))) + +(define emacs-standard-library? + (let ((libs '("emacs" "cl-lib"))) + (lambda (lib) + "Return true if LIB is part of Emacs itself. The check is not +exhaustive and only attempts to recognize a subset of packages which in the +past were distributed separately from Emacs." + (member lib libs)))) + +(define (filter-dependencies names) + "Remove the package names included with Emacs from the list of +NAMES (strings)." + (filter emacs-standard-library? names)) + +(define (elpa-name->package-name name) + "Given the NAME of an Emacs package, return the corresponding Guix name." + (let ((package-name-prefix "emacs-")) + (if (string-prefix? package-name-prefix name) + (string-downcase name) + (string-append package-name-prefix (string-downcase name))))) + +(define* (elpa-url #:optional (repo 'gnu)) + "Retrun the URL of REPO." + (let ((elpa-archives + '((gnu . "http://elpa.gnu.org/packages") + (melpa-stable . "http://stable.melpa.org/packages") + (melpa . "http://melpa.org/packages")))) + (assq-ref elpa-archives repo))) + +(define* (elpa-fetch-archive #:optional (repo 'gnu)) + "Retrive the archive with the list of packages available from REPO." + (let ((url (and=> (elpa-url repo) + (cut string-append <> "/archive-contents")))) + (if url + (call-with-downloaded-file url read) + (leave (_ "~A: currently not supported~%") repo)))) + +(define* (call-with-downloaded-file url proc + #:optional (err-msg "unavailable")) + "Fetch URL, store the content in a temporary file and call PROC with that +file. Returns the value returned by PROC." + (call-with-temporary-output-file + (lambda (temp port) + (or (and (url-fetch url temp) + (call-with-input-file temp proc)) + (error err-msg url))))) + +(define (is-elpa-package? name elpa-pkg-spec) + "Return true if the string NAME corresponds to the name of the package +defined by ELPA-PKG-SPEC, a package specification as in an archive +'archive-contents' file." + (eq? (first elpa-pkg-spec) (string->symbol name))) + +(define* (elpa-package-info name #:optional (repo 'gnu)) + "Extract the information about the package NAME from the package archieve of +REPO." + (let* ((archive (elpa-fetch-archive repo)) + (pkgs (match archive ((version pkg-spec ...) pkg-spec))) + (info (filter (cut is-elpa-package? name <>) pkgs))) + (if (pair? info) (first info) #f))) + +;; Object to store information about an ELPA package. +(define-record-type <elpa-package> + (make-elpa-package name version inputs synopsis kind home-page description + source-url) + elpa-package? + (name elpa-package-name) + (version elpa-package-version) + (inputs elpa-package-inputs) + (synopsis elpa-package-synopsis) + (kind elpa-package-kind) + (home-page elpa-package-home-page) + (description elpa-package-description) + (source-url elpa-package-source-url)) + +(set-record-type-printer! <elpa-package> + (lambda (package port) + (format port "#<elpa-package ~a-~a>" + (elpa-package-name package) + (elpa-package-version package)))) + +(define (elpa-version->string elpa-version) + "Convert the package version as used in Emacs package files into a string." + (if (pair? elpa-version) + (let-values (((ms rest) (match elpa-version + ((ms . rest) + (values ms rest))))) + (fold (lambda (n s) (string-append s "." (number->string n))) + (number->string ms) rest)) + #f)) + +(define (package-home-page alist) + "Extract the package home-page from ALIST." + (or (assq-ref alist ':url) "unspecified")) + +(define (ensure-list alist) + "If ALIST is the symbol 'nil return the empty list. Otherwise, return ALIST." + (if (eq? alist 'nil) + '() + alist)) + +(define (package-source-url kind name version repo) + "Return the source URL of the package described the the strings NAME and +VERSION at REPO. KIND is either the symbol 'single or 'tar." + (case kind + ((single) (full-url repo name ".el" version)) + ((tar) (full-url repo name ".tar" version)) + (else + #f))) + +(define* (full-url repo name suffix #:optional (version #f)) + "Return the full URL of the package NAME at REPO and the SUFFIX. Maybe +include VERSION." + (if version + (string-append (elpa-url repo) "/" name "-" version suffix) + (string-append (elpa-url repo) "/" name suffix))) + +(define (fetch-package-description kind name repo) + "Fetch the description of package NAME of type KIND from REPO." + (let ((url (full-url repo name "-readme.txt"))) + (call-with-downloaded-file url read-string))) + +(define* (fetch-elpa-package name #:optional (repo 'gnu)) + "Fetch package NAME from REPO." + (let ((pkg (elpa-package-info name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (ensure-list reqs) synopsis kind + (package-home-page (first rest)) + (fetch-package-description kind name repo) + url))) + (_ #f)))) + +(define* (elpa-package->sexp pkg) + "Return the `package' S-expression for the Emacs package PKG, a record of +type '<elpa-package>'." + + (define name (elpa-package-name pkg)) + + (define version (elpa-package-version pkg)) + + (define source-url (elpa-package-source-url pkg)) + + (define dependencies + (let* ((deps (elpa-package-inputs pkg)) + (names (filter-dependencies (elpa-dependencies->names deps)))) + (map (lambda (n) + (let ((new-n (elpa-name->package-name n))) + (list new-n (list 'unquote (string->symbol new-n))))) + names))) + + (define (maybe-inputs input-type inputs) + (match inputs + (() + '()) + ((inputs ...) + (list (list input-type + (list 'quasiquote inputs)))))) + + (let ((tarball (with-store store + (download-to-store store source-url)))) + `(package + (name ,(elpa-name->package-name name)) + (version ,version) + (source (origin + (method url-fetch) + (uri (string-append ,@(factorize-uri source-url version))) + (sha256 + (base32 + ,(if tarball + (bytevector->nix-base32-string (file-sha256 tarball)) + "failed to download package"))))) + (build-system emacs-build-system) + ,@(maybe-inputs 'inputs dependencies) + (home-page ,(elpa-package-home-page pkg)) + (synopsis ,(elpa-package-synopsis pkg)) + (description ,(elpa-package-description pkg)) + (license license:gpl3+)))) + +(define* (elpa->guix-package name #:optional (repo 'gnu)) + "Fetch the package NAME from REPO and produce a Guix package S-expression." + (let ((pkg (fetch-elpa-package name repo))) + (and=> pkg elpa-package->sexp))) + +;;; elpa.scm ends here diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm index 45ce092..d0bdec1 100644 --- a/guix/scripts/import.scm +++ b/guix/scripts/import.scm @@ -73,7 +73,7 @@ rather than \\n." ;;; Entry point. ;;; -(define importers '("gnu" "nix" "pypi" "cpan" "hackage")) +(define importers '("gnu" "nix" "pypi" "cpan" "hackage" "elpa")) (define (resolve-importer name) (let ((module (resolve-interface diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm new file mode 100644 index 0000000..9034eb7 --- /dev/null +++ b/guix/scripts/import/elpa.scm @@ -0,0 +1,98 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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 elpa) + #:use-module (guix ui) + #:use-module (guix utils) + #:use-module (guix import elpa) + #: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-elpa)) + +\f +;;; +;;; Command-line options. +;;; + +(define %default-options + '((repo . 'gnu))) + +(define (show-help) + (display (_ "Usage: guix import elpa PACKAGE-NAME +Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) + (display (_ " + -a, --archive=ARCHIVE specify the archive repository")) + (display (_ " + -h, --help display this help and exit")) + (display (_ " + -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 elpa"))) + (option '(#\a "archive") #t #f + (lambda (opt name arg result) + (alist-cons 'repo (string->symbol arg) + (alist-delete 'repo result)))) + %standard-import-options)) + +\f +;;; +;;; Entry point. +;;; + +(define (guix-import-elpa . args) + (define (parse-options) + ;; Return the alist of option values. + (args-fold* args %options + (lambda (opt name arg result) + (leave (_ "~A: unrecognized option~%") name)) + (lambda (arg result) + (alist-cons 'argument arg result)) + %default-options)) + + (let* ((opts (parse-options)) + (args (filter-map (match-lambda + (('argument . value) + value) + (_ #f)) + (reverse opts)))) + (match args + ((package-name) + (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (unless sexp + (leave (_ "failed to download package '~a'~%") package-name)) + sexp)) + (() + (leave (_ "too few arguments~%"))) + ((many ...) + (leave (_ "too many arguments~%")))))) + +;;; elpa.scm ends here diff --git a/tests/elpa.scm b/tests/elpa.scm new file mode 100644 index 0000000..5d2914b --- /dev/null +++ b/tests/elpa.scm @@ -0,0 +1,109 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> +;;; +;;; 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-elpa) + #:use-module (guix import elpa) + #:use-module (guix tests) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64) + #:use-module (ice-9 match)) + +(define elpa-mock-archive + '(1 + (ace-window . + [(0 9 0) + ((avy + (0 2 0))) + "Quickly switch windows." single + ((:url . "https://github.com/abo-abo/ace-window") + (:keywords "window" "location"))]) + (auctex . + [(11 88 6) + nil "Integrated environment for *TeX*" tar + ((:url . "http://www.gnu.org/software/auctex/"))]))) + +(define auctex-readme-mock "This is the AUCTeX description.") + +(define* (elpa-package-info-mock name #:optional (repo "gnu")) + "Simulate retrieval of 'archive-contents' file from REPO and extraction of +information about package NAME. (Function 'elpa-package-info'.)" + (let* ((archive elpa-mock-archive) + (info (filter (lambda (p) (eq? (first p) (string->symbol name))) + (cdr archive)))) + (if (pair? info) (first info) #f))) + +(define elpa-version->string + (@@ (guix import elpa) elpa-version->string)) + +(define package-source-url + (@@ (guix import elpa) package-source-url)) + +(define nil->empty + (@@ (guix import elpa) nil->empty)) + +(define package-home-page + (@@ (guix import elpa) package-home-page)) + +(define make-elpa-package + (@@ (guix import elpa) make-elpa-package)) + +(test-begin "elpa") + +(define (eval-test-with-elpa pkg) + (mock + ;; replace the two fetching functions + ((guix import elpa) fetch-elpa-package + (lambda* (name #:optional (repo "gnu")) + (let ((pkg (elpa-package-info-mock name repo))) + (match pkg + ((name version reqs synopsis kind . rest) + (let* ((name (symbol->string name)) + (ver (elpa-version->string version)) + (url (package-source-url kind name ver repo))) + (make-elpa-package name ver + (nil->empty reqs) synopsis kind + (package-home-page (first rest)) + auctex-readme-mock + url))) + (_ #f))))) + (match (elpa->guix-package pkg) + (('package + ('name "emacs-auctex") + ('version "11.88.6") + ('source + ('origin + ('method 'url-fetch) + ('uri ('string-append + "http://elpa.gnu.org/packages/auctex-" 'version ".tar")) + ('sha256 ('base32 (? string? hash))))) + ('build-system 'emacs-build-system) + ('home-page "http://www.gnu.org/software/auctex/") + ('synopsis "Integrated environment for *TeX*") + ('description (? string?)) + ('license 'license:gpl3+)) + #t) + (x + (pk 'fail x #f))))) + +(test-assert "elpa->guix-package test 1" + (eval-test-with-elpa "auctex")) + +(test-end "elpa") + +\f +(exit (= (test-runner-fail-count (test-runner-current)) 0)) -- 2.2.1 ^ permalink raw reply related [flat|nested] 7+ messages in thread
* Re: [PATCH 1/5] import: Add 'elpa' importer 2015-06-27 8:13 ` Federico Beffa @ 2015-06-27 10:08 ` Ludovic Courtès 0 siblings, 0 replies; 7+ messages in thread From: Ludovic Courtès @ 2015-06-27 10:08 UTC (permalink / raw) To: Federico Beffa; +Cc: Guix-devel, Alex Kost Federico Beffa <beffa@ieee.org> skribis: > From 56c460213d76ff2b88fd771b48997c3e03200234 Mon Sep 17 00:00:00 2001 > From: Federico Beffa <beffa@fbengineering.ch> > Date: Tue, 16 Jun 2015 10:50:06 +0200 > Subject: [PATCH 1/6] import: Add 'elpa' importer. > > * guix/import/elpa.scm: New file. > * guix/scripts/import.scm: Add "elpa" to 'importers'. > * guix/scripts/import/elpa.scm: New file. > * Makefile.am (MODULES): Add 'guix/import/elpa.scm' and > 'guix/scripts/import/elpa.scm'. > (SCM_TESTS): Add 'tests/elpa.scm'. > * doc/guix.texi (Invoking guix import): Document it. > * tests/elpa.scm: New file. Please add guix/scripts/import/elpa.scm to po/guix/POTFILES.in (sorry, I had forgotten about it.) [...] > +(define* (call-with-downloaded-file url proc > + #:optional (err-msg "unavailable")) > + "Fetch URL, store the content in a temporary file and call PROC with that > +file. Returns the value returned by PROC." > + (call-with-temporary-output-file > + (lambda (temp port) > + (or (and (url-fetch url temp) > + (call-with-input-file temp proc)) > + (error err-msg url))))) Please fix the indentation. Remove the ‘err-msg’ parameter, and change the ‘error’ call to: (error "download failed" url) OK to push with these changes. Thanks! Ludo’. ^ permalink raw reply [flat|nested] 7+ messages in thread
end of thread, other threads:[~2015-06-27 10:08 UTC | newest] Thread overview: 7+ messages (download: mbox.gz follow: Atom feed -- links below jump to the message on this page -- 2015-06-21 8:28 [PATCH 1/5] import: Add 'elpa' importer Federico Beffa 2015-06-21 20:39 ` Alex Kost 2015-06-24 16:15 ` Federico Beffa 2015-06-24 21:06 ` Ludovic Courtès 2015-06-25 18:33 ` Federico Beffa 2015-06-27 8:13 ` Federico Beffa 2015-06-27 10:08 ` Ludovic Courtès
Code repositories for project(s) associated with this public inbox https://git.savannah.gnu.org/cgit/guix.git This is a public inbox, see mirroring instructions for how to clone and mirror all data and code used for this inbox; as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).