all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [bug#31399] [PATCH] import: elpa: Implement recursive import.
@ 2018-05-10  8:37 Oleg Pykhalov
  2018-05-25 12:00 ` Ludovic Courtès
  0 siblings, 1 reply; 9+ messages in thread
From: Oleg Pykhalov @ 2018-05-10  8:37 UTC (permalink / raw)
  To: 31399


[-- Attachment #1.1: Type: text/plain, Size: 245 bytes --]

Hello Guix,

I stole recursive importer from ‘cran’ and made it for ‘elpa’, the patch
is attached.  I don't like it and want to share the code with ‘cran’
importer, but I don't know how to do it without increasing complexity.


[-- Attachment #1.2: [PATCH] emacs: implement recursive-import. --]
[-- Type: text/x-patch, Size: 8220 bytes --]

From 5c5023c5f343d673e96517b822b5e884ff20f714 Mon Sep 17 00:00:00 2001
From: Oleg Pykhalov <go.wigust@gmail.com>
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 '<elpa-package>'."
    (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))
 
 \f
@@ -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


[-- Attachment #1.3: Type: text/plain, Size: 7 bytes --]


Oleg.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply related	[flat|nested] 9+ messages in thread
end of thread, other threads:[~2018-06-08 19:36 UTC | newest]

Thread overview: 9+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2018-05-10  8:37 [bug#31399] [PATCH] import: elpa: Implement recursive import Oleg Pykhalov
2018-05-25 12:00 ` Ludovic Courtès
2018-05-25 12:50   ` Ricardo Wurmus
2018-05-29 14:31     ` Ludovic Courtès
2018-05-30 16:35       ` Oleg Pykhalov
2018-06-01 20:40         ` Ludovic Courtès
2018-06-08 12:08           ` Oleg Pykhalov
2018-06-08 12:59             ` Ricardo Wurmus
2018-06-08 19:35               ` Ludovic Courtès

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.