[PATCH 10/12] RECURSIVE IMPORTER wip

[David Craven]

---
 guix/import/crate.scm | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)

diff --git a/guix/import/crate.scm b/guix/import/crate.scm
index 45d5bf846..632c35f0a 100644
--- a/guix/import/crate.scm
+++ b/guix/import/crate.scm
@@ -156,3 +156,64 @@ VERSION, INPUTS, NATIVE-INPUTS, HOME-PAGE, SYNOPSIS, 
DESCRIPTION, and LICENSE."
    (pred crate-package?)
    (latest latest-release)))
 
+;;;
+;;; Recursive importer
+;;;
+
+(define-public (recursive-import crate-name)
+  (define (crate-inputs crate-name)
+    (crate-fetch
+     crate-name
+     (lambda* (#:key inputs native-inputs #:allow-other-keys)
+       (append inputs native-inputs))))
+
+  (define (crate->input-list crate-name crate-list)
+    (let ((crates (cons crate-name crate-list))
+          (inputs (crate-inputs crate-name)))
+      (for-each
+       (lambda (crate)
+         (when (not (member crate crates))
+           (format #t "Needs ~s crate.~%" crate)
+           (set! crates (crate->input-list crate crates))))
+       inputs)
+      crates))
+
+  (define (recursive-crate-inputs crate-name)
+    (crate->input-list crate-name '()))
+
+  (and-let* ((crates (recursive-crate-inputs crate-name))
+             (crates-sorted (sort crates string<?))
+             (packages (map crate->guix-package crates-sorted))
+             (definitions (map package->definition packages)))
+    (for-each
+     (lambda (expr)
+       (pretty-print expr (newline-rewriting-port
+                           (current-output-port))))
+     definitions)))
+
+
+(define (newline-rewriting-port output)
+  "Return an output port that rewrites strings containing the \\n escape
+to an actual newline.  This works around the behavior of `pretty-print'
+and `write', which output these as \\n instead of actual newlines,
+whereas we want the `description' field to contain actual newlines
+rather than \\n."
+  (define (write-string str)
+    (let loop ((chars (string->list str)))
+      (match chars
+        (()
+         #t)
+        ((#\\ #\n rest ...)
+         (newline output)
+         (loop rest))
+        ((chr rest ...)
+         (write-char chr output)
+         (loop rest)))))
+
+  (make-soft-port (vector (cut write-char <>)
+                          write-string
+                          (lambda _ #t)           ; flush
+                          #f
+                          (lambda _ #t)           ; close
+                          #f)
+                  "w"))
-- 
2.11.0