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.

2 files changed, 85 insertions, 70 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))))))))