From: Oleg Pykhalov <go.wigust@gmail.com>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: Ricardo Wurmus <rekado@elephly.net>,
Ricardo Wurmus <ricardo.wurmus@mdc-berlin.de>,
31399@debbugs.gnu.org
Subject: [bug#31399] [PATCH] import: elpa: Implement recursive import.
Date: Wed, 30 May 2018 19:35:16 +0300 [thread overview]
Message-ID: <87efhtdruj.fsf@gmail.com> (raw)
In-Reply-To: <877enmzg6d.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Tue, 29 May 2018 16:31:54 +0200")
[-- Attachment #1.1: Type: text/plain, Size: 208 bytes --]
Hello,
ludo@gnu.org (Ludovic Courtès) writes:
[…]
> Oleg, could you factorize what’s common between the two importers in
> (guix import utils) like Ricardo suggests?
OK, here is a patch:
[-- Attachment #1.2: import: utils: Add recursive-import. --]
[-- Type: text/x-patch, Size: 19451 bytes --]
From 80015053776fb8b3aad6ae730c0e32f655536d9e Mon Sep 17 00:00:00 2001
From: Oleg Pykhalov <go.wigust@gmail.com>
Date: Wed, 30 May 2018 19:08:50 +0300
Subject: [PATCH] import: utils: Add recursive-import.
* doc/guix.texi (Invoking guix import): Document elpa recursive import.
* guix/import/cran.scm (cran-guix-name, cran-recursive-import): New
procedures.
(recursive-import): Remove procedure.
* guix/import/elpa.scm (elpa-package->sexp): Return package and
dependencies values.
(elpa-guix-name, elpa-recursive-import): New procedures.
* guix/import/utils.scm (guix-name, recursive-import): New procedures.
* guix/scripts/import/cran.scm (guix-import-cran): Use
'cran-recursive-import' procedure.
* guix/scripts/import/elpa.scm (show-help, %options): Add recursive
option.
(guix-import-elpa): Use 'elpa-recursive-import'.
---
doc/guix.texi | 6 +++
guix/import/cran.scm | 77 +++++-------------------------------
guix/import/elpa.scm | 63 ++++++++++++++++++-----------
guix/import/utils.scm | 77 +++++++++++++++++++++++++++++++++++-
guix/scripts/import/cran.scm | 6 ++-
guix/scripts/import/elpa.scm | 26 ++++++++++--
6 files changed, 156 insertions(+), 99 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 5129b998b..9dd5b31f1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6530,6 +6530,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/cran.scm b/guix/import/cran.scm
index ec2b7e602..b7d3392cd 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -43,7 +43,7 @@
#:use-module (gnu packages)
#:export (cran->guix-package
bioconductor->guix-package
- recursive-import
+ cran-recursive-import
%cran-updater
%bioconductor-updater
@@ -231,13 +231,7 @@ empty list when the FIELD cannot be found."
"translations"
"utils"))
-(define (guix-name name)
- "Return a Guix package name for a given R package name."
- (string-append "r-" (string-map (match-lambda
- (#\_ #\-)
- (#\. #\-)
- (chr (char-downcase chr)))
- name)))
+(define cran-guix-name (cut guix-name "r-" <>))
(define (needs-fortran? tarball)
"Check if the TARBALL contains Fortran source files."
@@ -318,7 +312,7 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(listify meta "Depends"))))))
(values
`(package
- (name ,(guix-name name))
+ (name ,(cran-guix-name name))
(version ,version)
(source (origin
(method url-fetch)
@@ -327,12 +321,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
(base32
,(bytevector->nix-base32-string (file-sha256 tarball))))))
,@(if (not (equal? (string-append "r-" name)
- (guix-name name)))
+ (cran-guix-name name)))
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
'())
(build-system r-build-system)
,@(maybe-inputs sysdepends)
- ,@(maybe-inputs (map guix-name propagate) 'propagated-inputs)
+ ,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
,@(maybe-inputs
`(,@(if (needs-fortran? tarball)
'("gfortran") '())
@@ -356,63 +350,10 @@ s-expression corresponding to that package, or #f on failure."
(and=> (fetch-description repo package-name)
(cut description->package repo <>)))))
-(define* (recursive-import package-name #:optional (repo 'cran))
- "Generate a stream of package expressions for PACKAGE-NAME and all its
-dependencies."
- (receive (package . dependencies)
- (cran->guix-package package-name repo)
- (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)
- (cran->guix-package (next state) repo))
-
- ;; predicate
- (negate done?)
-
- ;; generator: update the queue
- (lambda (state)
- (receive (package . dependencies)
- (cran->guix-package (next state) repo)
- (if package
- (update state (filter (cut unknown? <>
- (cons (next state)
- (imported state)))
- (car dependencies)))
- ;; TODO: Try the other archives before giving up
- (update state (imported state)))))
-
- ;; initial state
- (make-state (filter unknown? (car dependencies))
- (list package-name))))))))
+(define* (cran-recursive-import package-name #:optional (repo 'gnu))
+ (recursive-import package-name repo
+ #:repo->guix-package cran->guix-package
+ #:guix-name cran-guix-name))
\f
;;;
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 43e9eb60c..24021bf2d 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 <beffa@fbengineering.ch>
;;; 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.
;;;
@@ -26,6 +27,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 +40,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 +204,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 +224,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 +297,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/import/utils.scm b/guix/import/utils.scm
index efc616907..df85904c6 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
;;; Copyright © 2016 David Craven <david@craven.ch>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -39,6 +40,8 @@
#:use-module (ice-9 regex)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-26)
+ #:use-module (srfi srfi-41)
#:export (factorize-uri
hash-table->alist
@@ -61,7 +64,11 @@
alist->package
read-lines
- chunk-lines))
+ chunk-lines
+
+ guix-name
+
+ recursive-import))
(define (factorize-uri uri version)
"Factorize URI, a package tarball URI as a string, such that any occurrences
@@ -357,3 +364,71 @@ separated by PRED."
(if (null? after)
(reverse res)
(loop (cdr after) res))))))
+
+(define (guix-name prefix name)
+ "Return a Guix package name for a given package name."
+ (string-append prefix (string-map (match-lambda
+ (#\_ #\-)
+ (#\. #\-)
+ (chr (char-downcase chr)))
+ name)))
+
+(define* (recursive-import package-name repo
+ #:key repo->guix-package guix-name
+ #:allow-other-keys)
+ "Generate a stream of package expressions for PACKAGE-NAME and all its
+dependencies."
+ (receive (package . dependencies)
+ (repo->guix-package package-name repo)
+ (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)
+ (repo->guix-package (next state) repo))
+
+ ;; predicate
+ (negate done?)
+
+ ;; generator: update the queue
+ (lambda (state)
+ (receive (package . dependencies)
+ (repo->guix-package package-name repo)
+ (if package
+ (update state (filter (cut unknown? <>
+ (cons (next state)
+ (imported state)))
+ (car dependencies)))
+ ;; TODO: Try the other archives before giving up
+ (update state (imported state)))))
+
+ ;; initial state
+ (make-state (filter unknown? (car dependencies))
+ (list package-name))))))))
diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm
index d65c644c0..30ae6d434 100644
--- a/guix/scripts/import/cran.scm
+++ b/guix/scripts/import/cran.scm
@@ -99,8 +99,10 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
`(define-public ,(string->symbol name)
,pkg))
(_ #f))
- (reverse (stream->list (recursive-import package-name
- (or (assoc-ref opts 'repo) 'cran)))))
+ (reverse
+ (stream->list
+ (cran-recursive-import package-name
+ (or (assoc-ref opts 'repo) 'cran)))))
;; Single import
(let ((sexp (cran->guix-package package-name
(or (assoc-ref opts 'repo) 'cran))))
diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm
index 34eb16485..f1ed5016b 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 <beffa@fbengineering.ch>
+;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
;;;
;;; 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))
\f
@@ -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 ...)
--
2.17.0
[-- Attachment #1.3: Type: text/plain, Size: 7 bytes --]
Oleg.
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]
next prev parent reply other threads:[~2018-05-30 16:36 UTC|newest]
Thread overview: 9+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87efhtdruj.fsf@gmail.com \
--to=go.wigust@gmail.com \
--cc=31399@debbugs.gnu.org \
--cc=ludo@gnu.org \
--cc=rekado@elephly.net \
--cc=ricardo.wurmus@mdc-berlin.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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.