ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 15:36:20 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

import cran: Add recursive importer.

Browse source 
* guix/import/cran.scm (recursive-import): New variable.
(cran->guix-package): Memoize the procedure.
This commit is contained in:
Ricardo Wurmus 2016-05-17 16:38:17 +02:00 committed by Ricardo Wurmus
parent b26abe4f14
commit 94e907b962
No known key found for this signature in database
GPG key ID: 197A5888235FACAC
1 changed files with 71 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

78
guix/import/cran.scm
View file

@ -23,7 +23,9 @@ (define-module (guix import cran)
#:use-module ((ice-9 rdelim) #:select (read-string))
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-41)
#:use-module (ice-9 receive)
#:use-module (guix combinators)
#:use-module (guix http-client)
#:use-module (guix hash)
#:use-module (guix store)
@ -33,8 +35,10 @@ (define-module (guix import cran)
#:use-module ((guix build-system r) #:select (cran-uri bioconductor-uri))
#:use-module (guix upstream)
#:use-module (guix packages)
#:use-module (gnu packages)
#:export (cran->guix-package
bioconductor->guix-package
recursive-import
%cran-updater
%bioconductor-updater))
@ -245,14 +249,74 @@ (define (description->package repository meta)
(license ,license))
propagate)))
(define* (cran->guix-package package-name #:optional (repo 'cran))
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
(define cran->guix-package
(memoize
(lambda* (package-name #:optional (repo 'cran))
"Fetch the metadata for PACKAGE-NAME from REPO and return the `package'
s-expression corresponding to that package, or #f on failure."
(let* ((url (case repo
((cran) %cran-url)
((bioconductor) %bioconductor-svn-url)))
(module-meta (fetch-description url package-name)))
(and=> module-meta (cut description->package repo <>))))
(let* ((url (case repo
((cran) %cran-url)
((bioconductor) %bioconductor-svn-url)))
(module-meta (fetch-description url package-name)))
(and=> module-meta (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
(compose not 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))))))))
;;;