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'.
This commit is contained in:
Oleg Pykhalov 2018-06-08 13:49:29 +03:00
parent ae9e5d6602
commit 74032da3a2
No known key found for this signature in database
GPG Key ID: 7246E11C69B79569
3 changed files with 66 additions and 28 deletions

View File

@ -6586,6 +6586,12 @@ signatures,, emacs, The GNU Emacs Manual}).
@uref{http://melpa.org/packages, MELPA}, selected by the @code{melpa} @uref{http://melpa.org/packages, MELPA}, selected by the @code{melpa}
identifier. identifier.
@end itemize @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 @end table
@item crate @item crate

View File

@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -26,6 +27,7 @@
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (gnu packages)
#:use-module ((guix download) #:select (download-to-store)) #:use-module ((guix download) #:select (download-to-store))
#:use-module (guix import utils) #:use-module (guix import utils)
#:use-module (guix http-client) #:use-module (guix http-client)
@ -37,7 +39,8 @@
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix utils) #:select (call-with-temporary-output-file)) #:use-module ((guix utils) #:select (call-with-temporary-output-file))
#:export (elpa->guix-package #:export (elpa->guix-package
%elpa-updater)) %elpa-updater
elpa-recursive-import))
(define (elpa-dependencies->names deps) (define (elpa-dependencies->names deps)
"Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of
@ -200,13 +203,15 @@ type '<elpa-package>'."
(define source-url (elpa-package-source-url pkg)) (define source-url (elpa-package-source-url pkg))
(define dependencies-names
(filter-dependencies (elpa-dependencies->names
(elpa-package-inputs pkg))))
(define dependencies (define dependencies
(let* ((deps (elpa-package-inputs pkg)) (map (lambda (n)
(names (filter-dependencies (elpa-dependencies->names deps)))) (let ((new-n (elpa-name->package-name n)))
(map (lambda (n) (list new-n (list 'unquote (string->symbol new-n)))))
(let ((new-n (elpa-name->package-name n))) dependencies-names))
(list new-n (list 'unquote (string->symbol new-n)))))
names)))
(define (maybe-inputs input-type inputs) (define (maybe-inputs input-type inputs)
(match inputs (match inputs
@ -218,23 +223,25 @@ type '<elpa-package>'."
(let ((tarball (with-store store (let ((tarball (with-store store
(download-to-store store source-url)))) (download-to-store store source-url))))
`(package (values
(name ,(elpa-name->package-name name)) `(package
(version ,version) (name ,(elpa-name->package-name name))
(source (origin (version ,version)
(method url-fetch) (source (origin
(uri (string-append ,@(factorize-uri source-url version))) (method url-fetch)
(sha256 (uri (string-append ,@(factorize-uri source-url version)))
(base32 (sha256
,(if tarball (base32
(bytevector->nix-base32-string (file-sha256 tarball)) ,(if tarball
"failed to download package"))))) (bytevector->nix-base32-string (file-sha256 tarball))
(build-system emacs-build-system) "failed to download package")))))
,@(maybe-inputs 'propagated-inputs dependencies) (build-system emacs-build-system)
(home-page ,(elpa-package-home-page pkg)) ,@(maybe-inputs 'propagated-inputs dependencies)
(synopsis ,(elpa-package-synopsis pkg)) (home-page ,(elpa-package-home-page pkg))
(description ,(elpa-package-description pkg)) (synopsis ,(elpa-package-synopsis pkg))
(license ,license)))) (description ,(elpa-package-description pkg))
(license ,license))
dependencies-names)))
(define* (elpa->guix-package name #:optional (repo 'gnu)) (define* (elpa->guix-package name #:optional (repo 'gnu))
"Fetch the package NAME from REPO and produce a Guix package S-expression." "Fetch the package NAME from REPO and produce a Guix package S-expression."
@ -289,4 +296,11 @@ type '<elpa-package>'."
(pred package-from-gnu.org?) (pred package-from-gnu.org?)
(latest latest-release))) (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 ;;; elpa.scm ends here

View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch> ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -21,10 +22,12 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts) #:use-module (guix scripts)
#:use-module (guix import elpa) #:use-module (guix import elpa)
#:use-module (guix import utils)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-37) #:use-module (srfi srfi-37)
#:use-module (srfi srfi-41)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (guix-import-elpa)) #:export (guix-import-elpa))
@ -45,6 +48,8 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
(display (G_ " (display (G_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))
(display (G_ " (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")) -V, --version display version information and exit"))
(newline) (newline)
(show-bug-report-information)) (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) (lambda (opt name arg result)
(alist-cons 'repo (string->symbol arg) (alist-cons 'repo (string->symbol arg)
(alist-delete 'repo result)))) (alist-delete 'repo result))))
(option '(#\r "recursive") #f #f
(lambda (opt name arg result)
(alist-cons 'recursive #t result)))
%standard-import-options)) %standard-import-options))
@ -87,10 +95,20 @@ Import the latest package named PACKAGE-NAME from an ELPA repository.\n"))
(reverse opts)))) (reverse opts))))
(match args (match args
((package-name) ((package-name)
(let ((sexp (elpa->guix-package package-name (assoc-ref opts 'repo)))) (if (assoc-ref opts 'recursive)
(unless sexp (map (match-lambda
(leave (G_ "failed to download package '~a'~%") package-name)) ((and ('package ('name name) . rest) pkg)
sexp)) `(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~%"))) (leave (G_ "too few arguments~%")))
((many ...) ((many ...)