import: utils: Add recursive-import.
* guix/import/cran.scm (cran-guix-name, cran-recursive-import): New procedures. (recursive-import): Remove procedure. * guix/import/utils.scm (guix-name, recursive-import): New procedures. * guix/scripts/import/cran.scm (guix-import-cran): Use 'cran-recursive-import' procedure.
This commit is contained in:
parent
0b2fd1600f
commit
ae9e5d6602
|
@ -25,7 +25,6 @@
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:use-module (srfi srfi-34)
|
#:use-module (srfi srfi-34)
|
||||||
#:use-module (srfi srfi-41)
|
|
||||||
#:use-module (ice-9 receive)
|
#:use-module (ice-9 receive)
|
||||||
#:use-module (web uri)
|
#:use-module (web uri)
|
||||||
#:use-module (guix memoization)
|
#:use-module (guix memoization)
|
||||||
|
@ -43,7 +42,7 @@
|
||||||
#:use-module (gnu packages)
|
#:use-module (gnu packages)
|
||||||
#:export (cran->guix-package
|
#:export (cran->guix-package
|
||||||
bioconductor->guix-package
|
bioconductor->guix-package
|
||||||
recursive-import
|
cran-recursive-import
|
||||||
%cran-updater
|
%cran-updater
|
||||||
%bioconductor-updater
|
%bioconductor-updater
|
||||||
|
|
||||||
|
@ -231,13 +230,7 @@ empty list when the FIELD cannot be found."
|
||||||
"translations"
|
"translations"
|
||||||
"utils"))
|
"utils"))
|
||||||
|
|
||||||
(define (guix-name name)
|
(define cran-guix-name (cut guix-name "r-" <>))
|
||||||
"Return a Guix package name for a given R package name."
|
|
||||||
(string-append "r-" (string-map (match-lambda
|
|
||||||
(#\_ #\-)
|
|
||||||
(#\. #\-)
|
|
||||||
(chr (char-downcase chr)))
|
|
||||||
name)))
|
|
||||||
|
|
||||||
(define (needs-fortran? tarball)
|
(define (needs-fortran? tarball)
|
||||||
"Check if the TARBALL contains Fortran source files."
|
"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"))))))
|
(listify meta "Depends"))))))
|
||||||
(values
|
(values
|
||||||
`(package
|
`(package
|
||||||
(name ,(guix-name name))
|
(name ,(cran-guix-name name))
|
||||||
(version ,version)
|
(version ,version)
|
||||||
(source (origin
|
(source (origin
|
||||||
(method url-fetch)
|
(method url-fetch)
|
||||||
|
@ -327,12 +320,12 @@ from the alist META, which was derived from the R package's DESCRIPTION file."
|
||||||
(base32
|
(base32
|
||||||
,(bytevector->nix-base32-string (file-sha256 tarball))))))
|
,(bytevector->nix-base32-string (file-sha256 tarball))))))
|
||||||
,@(if (not (equal? (string-append "r-" name)
|
,@(if (not (equal? (string-append "r-" name)
|
||||||
(guix-name name)))
|
(cran-guix-name name)))
|
||||||
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
|
`((properties ,`(,'quasiquote ((,'upstream-name . ,name)))))
|
||||||
'())
|
'())
|
||||||
(build-system r-build-system)
|
(build-system r-build-system)
|
||||||
,@(maybe-inputs sysdepends)
|
,@(maybe-inputs sysdepends)
|
||||||
,@(maybe-inputs (map guix-name propagate) 'propagated-inputs)
|
,@(maybe-inputs (map cran-guix-name propagate) 'propagated-inputs)
|
||||||
,@(maybe-inputs
|
,@(maybe-inputs
|
||||||
`(,@(if (needs-fortran? tarball)
|
`(,@(if (needs-fortran? tarball)
|
||||||
'("gfortran") '())
|
'("gfortran") '())
|
||||||
|
@ -356,63 +349,10 @@ s-expression corresponding to that package, or #f on failure."
|
||||||
(and=> (fetch-description repo package-name)
|
(and=> (fetch-description repo package-name)
|
||||||
(cut description->package repo <>)))))
|
(cut description->package repo <>)))))
|
||||||
|
|
||||||
(define* (recursive-import package-name #:optional (repo 'cran))
|
(define* (cran-recursive-import package-name #:optional (repo 'gnu))
|
||||||
"Generate a stream of package expressions for PACKAGE-NAME and all its
|
(recursive-import package-name repo
|
||||||
dependencies."
|
#:repo->guix-package cran->guix-package
|
||||||
(receive (package . dependencies)
|
#:guix-name cran-guix-name))
|
||||||
(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))))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;;
|
;;;
|
||||||
|
|
|
@ -3,6 +3,7 @@
|
||||||
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
|
;;; Copyright © 2016 Jelle Licht <jlicht@fsfe.org>
|
||||||
;;; Copyright © 2016 David Craven <david@craven.ch>
|
;;; Copyright © 2016 David Craven <david@craven.ch>
|
||||||
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
|
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
|
||||||
|
;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -39,6 +40,8 @@
|
||||||
#:use-module (ice-9 regex)
|
#:use-module (ice-9 regex)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-11)
|
#:use-module (srfi srfi-11)
|
||||||
|
#:use-module (srfi srfi-26)
|
||||||
|
#:use-module (srfi srfi-41)
|
||||||
#:export (factorize-uri
|
#:export (factorize-uri
|
||||||
|
|
||||||
hash-table->alist
|
hash-table->alist
|
||||||
|
@ -61,7 +64,11 @@
|
||||||
alist->package
|
alist->package
|
||||||
|
|
||||||
read-lines
|
read-lines
|
||||||
chunk-lines))
|
chunk-lines
|
||||||
|
|
||||||
|
guix-name
|
||||||
|
|
||||||
|
recursive-import))
|
||||||
|
|
||||||
(define (factorize-uri uri version)
|
(define (factorize-uri uri version)
|
||||||
"Factorize URI, a package tarball URI as a string, such that any occurrences
|
"Factorize URI, a package tarball URI as a string, such that any occurrences
|
||||||
|
@ -357,3 +364,71 @@ separated by PRED."
|
||||||
(if (null? after)
|
(if (null? after)
|
||||||
(reverse res)
|
(reverse res)
|
||||||
(loop (cdr after) 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))))))))
|
||||||
|
|
|
@ -99,8 +99,10 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
|
||||||
`(define-public ,(string->symbol name)
|
`(define-public ,(string->symbol name)
|
||||||
,pkg))
|
,pkg))
|
||||||
(_ #f))
|
(_ #f))
|
||||||
(reverse (stream->list (recursive-import package-name
|
(reverse
|
||||||
(or (assoc-ref opts 'repo) 'cran)))))
|
(stream->list
|
||||||
|
(cran-recursive-import package-name
|
||||||
|
(or (assoc-ref opts 'repo) 'cran)))))
|
||||||
;; Single import
|
;; Single import
|
||||||
(let ((sexp (cran->guix-package package-name
|
(let ((sexp (cran->guix-package package-name
|
||||||
(or (assoc-ref opts 'repo) 'cran))))
|
(or (assoc-ref opts 'repo) 'cran))))
|
||||||
|
|
Loading…
Reference in New Issue