diff options
| -rw-r--r-- | guix/import/cran.scm | 78 | ||||
| -rw-r--r-- | guix/import/utils.scm | 77 | ||||
| -rw-r--r-- | guix/scripts/import/cran.scm | 6 |
3 files changed, 89 insertions, 72 deletions
diff --git a/guix/import/cran.scm b/guix/import/cran.scm index 49e5d2d358..a5203fe78d 100644 --- a/guix/import/cran.scm +++ b/guix/import/cran.scm @@ -25,7 +25,6 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) - #:use-module (srfi srfi-41) #:use-module (ice-9 receive) #:use-module (web uri) #:use-module (guix memoization) @@ -43,7 +42,7 @@ #:use-module (gnu packages) #:export (cran->guix-package bioconductor->guix-package - recursive-import + cran-recursive-import %cran-updater %bioconductor-updater @@ -231,13 +230,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 +311,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 +320,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 +349,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/utils.scm b/guix/import/utils.scm index efc6169077..df85904c6f 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 d65c644c05..30ae6d4342 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)))) |