diff options
| -rw-r--r-- | Makefile.am | 3 | ||||
| -rw-r--r-- | doc/guix.texi | 28 | ||||
| -rw-r--r-- | guix/import/elpa.scm | 230 | ||||
| -rw-r--r-- | guix/scripts/import.scm | 2 | ||||
| -rw-r--r-- | guix/scripts/import/elpa.scm | 98 | ||||
| -rw-r--r-- | po/guix/POTFILES.in | 1 | ||||
| -rw-r--r-- | tests/elpa.scm | 109 |
7 files changed, 470 insertions, 1 deletions
diff --git a/Makefile.am b/Makefile.am index 44d3b09a82..63be2228a4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -97,6 +97,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 \ @@ -113,6 +114,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/scripts/edit.scm \ @@ -187,6 +189,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 284d667f34..d10279e992 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -3856,6 +3856,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 0000000000..3b3dc1f91a --- /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 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) + "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 "download failed" 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 45ce092f13..d0bdec133d 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 0000000000..9034eb74e7 --- /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)) + + +;;; +;;; 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)) + + +;;; +;;; 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/po/guix/POTFILES.in b/po/guix/POTFILES.in index 247fe2cf6a..ed8cc7f1cd 100644 --- a/po/guix/POTFILES.in +++ b/po/guix/POTFILES.in @@ -10,6 +10,7 @@ guix/scripts/package.scm guix/scripts/gc.scm guix/scripts/hash.scm guix/scripts/import.scm +guix/scripts/import/elpa.scm guix/scripts/pull.scm guix/scripts/substitute.scm guix/scripts/authenticate.scm diff --git a/tests/elpa.scm b/tests/elpa.scm new file mode 100644 index 0000000000..5d2914b8df --- /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") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) |