From 5c5023c5f343d673e96517b822b5e884ff20f714 Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov Date: Thu, 10 May 2018 10:07:49 +0300 Subject: [PATCH] import: elpa: Implement recursive import. * guix/import/elpa.scm (guix-name, recursive-import): New procedures. * guix/scripts/import/elpa.scm (%options): Add 'recursive-import'. (guix-import-elpa): Add this. (show-help): Document this. * doc/guix.texi (Invoking guix import): Document this. --- doc/guix.texi | 6 +++ guix/import/elpa.scm | 81 +++++++++++++++++++++++++++++++++++- guix/scripts/import/elpa.scm | 22 ++++++++-- 3 files changed, 104 insertions(+), 5 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 8b9f8721b..40d3a4c73 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6481,6 +6481,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 43e9eb60c..78a69dcc0 100644 --- a/guix/import/elpa.scm +++ b/guix/import/elpa.scm @@ -26,6 +26,8 @@ #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) + #:use-module (srfi srfi-41) + #: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 + recursive-import)) (define (elpa-dependencies->names deps) "Convert DEPS, a list of symbol/version pairs à la ELPA, to a list of @@ -289,4 +292,80 @@ type ''." (pred package-from-gnu.org?) (latest latest-release))) +(define (guix-name name) + "Return a Guix package name for a given Emacs package name." + (string-append "emacs-" (string-map (match-lambda + (#\_ #\-) + (#\. #\-) + (chr (char-downcase chr))) + name))) + +(define* (recursive-import package-name #:optional (repo 'gnu)) + "Generate a stream of package expressions for PACKAGE-NAME and all its +dependencies." + (define (propagated-inputs package) + "Return a list of package names in propagated inputs from PACKAGE." + (and=> (match package + ((package fields ...) (assq 'propagated-inputs fields)) + (#f #f)) + (match-lambda + ((propagated-inputs (qp ((package-name package) ...))) + (map (cut string-drop <> (string-length "emacs-")) + package-name)) + (#f #f)))) + (let* ((package (elpa->guix-package package-name repo)) + (dependencies (propagated-inputs package))) + (if (not package) + stream-null + + ;; Generate a lazy stream of package expressions for all unknown + ;; dependencies in the graph. + (let* ((make-state (lambda (queue done) + (cons queue done))) + (next (match-lambda + (((next . rest) . done) next))) + (imported (match-lambda + ((queue . done) done))) + (done? (match-lambda + ((queue . done) + (zero? (length queue))))) + (unknown? (lambda* (dependency #:optional (done '())) + (and (not (member dependency + done)) + (null? (find-packages-by-name + (guix-name dependency)))))) + (update (lambda (state new-queue) + (match state + (((head . tail) . done) + (make-state (lset-difference + equal? + (lset-union equal? new-queue tail) + done) + (cons head done))))))) + (stream-cons + package + (stream-unfold + ;; map: produce a stream element + (lambda (state) + (elpa->guix-package (next state) repo)) + + ;; predicate + (negate done?) + + ;; generator: update the queue + (lambda (state) + (let* ((package (elpa->guix-package (next state) repo)) + (dependencies (propagated-inputs package))) + (if package + (update state (filter (cut unknown? <> + (cons (next state) + (imported state))) + dependencies)) + ;; TODO: Try the other archives before giving up + (update state (imported state))))) + + ;; initial state + (make-state (filter unknown? dependencies) + (list package-name)))))))) + ;;; elpa.scm ends here diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index 34eb16485..c49c3ac9e 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -25,6 +25,7 @@ #: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 +46,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 +65,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 +93,18 @@ 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 (recursive-import package-name + (or (assoc-ref opts 'repo) 'cran))))) + (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 ...) -- 2.17.0