From 74032da3a2ef3e99e89dd58701414004f5a6c061 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Fri, 8 Jun 2018 13:49:29 +0300 Subject: [PATCH] import: elpa: Add recursive import. * doc/guix.texi (Invoking guix import): Document elpa recursive import. * guix/import/elpa.scm (elpa-package->sexp): Return package and dependencies values. (elpa-guix-name, elpa-recursive-import): New procedures. * guix/scripts/import/elpa.scm (show-help, %options): Add recursive option. (guix-import-elpa): Use 'elpa-recursive-import'. --- doc/guix.texi | 6 ++++ guix/import/elpa.scm | 62 ++++++++++++++++++++++-------------- guix/scripts/import/elpa.scm | 26 ++++++++++++--- 3 files changed, 66 insertions(+), 28 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index e1353842e4..1183565ad3 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6586,6 +6586,12 @@ signatures,, emacs, The GNU Emacs Manual}). @uref{http://melpa.org/packages, MELPA}, selected by the @code{melpa} identifier. @end itemize + +@item --recursive +@itemx -r +Traverse the dependency graph of the given upstream package recursively +and generate package expressions for all those packages that are not yet +in Guix. @end table @item crate diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm index 43e9eb60c9..0a95b3cb53 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +27,7 @@ #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (gnu packages) #:use-module ((guix download) #:select (download-to-store)) #:use-module (guix import utils) #:use-module (guix http-client) @@ -37,7 +39,8 @@ #:use-module (guix packages) #:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:export (elpa->guix-package - %elpa-updater)) + %elpa-updater + elpa-recursive-import)) (define (elpa-dependencies->names deps) "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of @@ -200,13 +203,15 @@ type ''." (define source-url (elpa-package-source-url pkg)) + (define dependencies-names + (filter-dependencies (elpa-dependencies->names + (elpa-package-inputs 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))) + (map (lambda (n) + (let ((new-n (elpa-name->package-name n))) + (list new-n (list 'unquote (string->symbol new-n))))) + dependencies-names)) (define (maybe-inputs input-type inputs) (match inputs @@ -218,23 +223,25 @@ type ''." (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 'propagated-inputs dependencies) - (home-page ,(elpa-package-home-page pkg)) - (synopsis ,(elpa-package-synopsis pkg)) - (description ,(elpa-package-description pkg)) - (license ,license)))) + (values + `(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 'propagated-inputs dependencies) + (home-page ,(elpa-package-home-page pkg)) + (synopsis ,(elpa-package-synopsis pkg)) + (description ,(elpa-package-description pkg)) + (license ,license)) + dependencies-names))) (define* (elpa->guix-package name #:optional (repo 'gnu)) "Fetch the package NAME from REPO and produce a Guix package S-expression." @@ -289,4 +296,11 @@ type ''." (pred package-from-gnu.org?) (latest latest-release))) +(define elpa-guix-name (cut guix-name "emacs-" <>)) + +(define* (elpa-recursive-import package-name #:optional (repo 'gnu)) + (recursive-import package-name repo + #:repo->guix-package elpa->guix-package + #:guix-name elpa-guix-name)) + ;;; elpa.scm ends here diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index 34eb16485e..f1ed5016ba 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 Federico Beffa +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,10 +22,12 @@ #:use-module (guix utils) #:use-module (guix scripts) #:use-module (guix import elpa) + #:use-module (guix import utils) #:use-module (guix scripts import) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-37) + #:use-module (srfi srfi-41) #:use-module (ice-9 match) #:use-module (ice-9 format) #:export (guix-import-elpa)) @@ -45,6 +48,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) (display (G_ " -h, --help display this help and exit")) (display (G_ " + -r, --recursive generate package expressions for all Emacs packages that are not yet in Guix")) + (display (G_ " -V, --version display version information and exit")) (newline) (show-bug-report-information)) @@ -62,6 +67,9 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) (lambda (opt name arg result) (alist-cons 'repo (string->symbol arg) (alist-delete 'repo result)))) + (option '(#\r "recursive") #f #f + (lambda (opt name arg result) + (alist-cons 'recursive #t result))) %standard-import-options)) @@ -87,10 +95,20 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n")) (reverse opts)))) (match args ((package-name) - (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) - (unless sexp - (leave (G_ "failed to download package '~a'~%") package-name)) - sexp)) + (if (assoc-ref opts 'recursive) + (map (match-lambda + ((and ('package ('name name) . rest) pkg) + `(define-public ,(string->symbol name) + ,pkg)) + (_ #f)) + (reverse + (stream->list + (elpa-recursive-import package-name + (or (assoc-ref opts 'repo) 'gnu))))) + (let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) + (unless sexp + (leave (G_ "failed to download package '~a'~%") package-name)) + sexp))) (() (leave (G_ "too few arguments~%"))) ((many ...)