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:
Oleg Pykhalov
parent
0b2fd1600f
commit
ae9e5d6602
|
|
@ -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))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -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))))))))
|
||||
|
|
|
|||
|
|
@ -99,7 +99,9 @@ Import and convert the CRAN package for PACKAGE-NAME.\n"))
|
|||
`(define-public ,(string->symbol name)
|
||||
,pkg))
|
||||
(_ #f))
|
||||
(reverse (stream->list (recursive-import package-name
|
||||
(reverse
|
||||
(stream->list
|
||||
(cran-recursive-import package-name
|
||||
(or (assoc-ref opts 'repo) 'cran)))))
|
||||
;; Single import
|
||||
(let ((sexp (cran->guix-package package-name
|
||||
|
|
|
|||
Loading…
Reference in New Issue