02/02: import: elpa: Add recursive import.

[Oleg Pykhalov]

wigust pushed a commit to branch master
in repository guix.

commit 74032da3a2ef3e99e89dd58701414004f5a6c061
Author: Oleg Pykhalov <address@hidden>
Date:   Fri Jun 8 13:49:29 2018 +0300

    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 e135384..1183565 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
+
address@hidden --recursive
address@hidden -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 43e9eb6..0a95b3c 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 <address@hidden>
 ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <address@hidden>
+;;; Copyright © 2018 Oleg Pykhalov <address@hidden>
 ;;;
 ;;; 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 '<elpa-package>'."
 
   (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 '<elpa-package>'."
 
   (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 '<elpa-package>'."
    (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 34eb164..f1ed501 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 <address@hidden>
+;;; Copyright © 2018 Oleg Pykhalov <address@hidden>
 ;;;
 ;;; 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 ...)