From 80015053776fb8b3aad6ae730c0e32f655536d9e Mon Sep 17 00:00:00 2001 From: Oleg Pykhalov 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 + 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/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)) ;;; 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 ;;; Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; 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 ''." (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 ''." (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 ''." (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 ;;; Copyright © 2016 David Craven ;;; Copyright © 2017 Ricardo Wurmus +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; 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 +;;; Copyright © 2018 Oleg Pykhalov ;;; ;;; 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 ...) -- 2.17.0