From 01ac19dca4318d577cf3bef53cfe6af590f0e5f8 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 24 Mar 2014 22:15:29 +0100
Subject: utils: Add 'call-with-decompressed-port' and
 'call-with-compressed-output-port'.

* guix/utils.scm (call-with-decompressed-port,
  call-with-compressed-output-port): New procedures.
* tests/utils.scm ("compressed-output-port + decompressed-port"):
  Rewrite to use them.
---
 .dir-locals.el  |  2 ++
 guix/utils.scm  | 37 ++++++++++++++++++++++++++++++++++++-
 tests/utils.scm | 27 ++++++++++-----------------
 3 files changed, 48 insertions(+), 18 deletions(-)

diff --git a/.dir-locals.el b/.dir-locals.el
index 03d9a4ec8d..22ade9f8a5 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -22,6 +22,8 @@
    (eval . (put 'with-error-handling 'scheme-indent-function 0))
    (eval . (put 'with-mutex 'scheme-indent-function 1))
    (eval . (put 'with-atomic-file-output 'scheme-indent-function 1))
+   (eval . (put 'call-with-compressed-output-port 'scheme-indent-function 2))
+   (eval . (put 'call-with-decompressed-port 'scheme-indent-function 2))
 
    (eval . (put 'syntax-parameterize 'scheme-indent-function 1))
    (eval . (put 'with-monad 'scheme-indent-function 1))
diff --git a/guix/utils.scm b/guix/utils.scm
index 44060c46b5..7306c6011d 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -21,6 +21,7 @@
   #:use-module (guix config)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-39)
   #:use-module (srfi srfi-60)
@@ -74,7 +75,9 @@
             filtered-port
             compressed-port
             decompressed-port
-            compressed-output-port))
+            call-with-decompressed-port
+            compressed-output-port
+            call-with-compressed-output-port))
 
 
 ;;;
@@ -224,6 +227,22 @@ a symbol such as 'xz."
     ('gzip         (filtered-port `(,%gzip "-c") input))
     (else          (error "unsupported compression scheme" compression))))
 
+(define (call-with-decompressed-port compression port proc)
+  "Call PROC with a wrapper around PORT, a file port, that decompresses data
+read from PORT according to COMPRESSION, a symbol such as 'xz.  PORT is closed
+as soon as PROC's dynamic extent is entered."
+  (let-values (((decompressed pids)
+                (decompressed-port compression port)))
+    (dynamic-wind
+      (const #f)
+      (lambda ()
+        (close-port port)
+        (proc decompressed))
+      (lambda ()
+        (close-port decompressed)
+        (unless (every (compose zero? cdr waitpid) pids)
+          (error "decompressed-port failure" pids))))))
+
 (define (filtered-output-port command output)
   "Return an output port.  Data written to that port is filtered through
 COMMAND and written to OUTPUT, an output file port.  In addition, return a
@@ -265,6 +284,22 @@ of PIDs to wait for."
     ('gzip         (filtered-output-port `(,%gzip "-c") output))
     (else          (error "unsupported compression scheme" compression))))
 
+(define (call-with-compressed-output-port compression port proc)
+  "Call PROC with a wrapper around PORT, a file port, that compresses data
+that goes to PORT according to COMPRESSION, a symbol such as 'xz.  PORT is
+closed as soon as PROC's dynamic extent is entered."
+  (let-values (((compressed pids)
+                (compressed-output-port compression port)))
+    (dynamic-wind
+      (const #f)
+      (lambda ()
+        (close-port port)
+        (proc compressed))
+      (lambda ()
+        (close-port compressed)
+        (unless (every (compose zero? cdr waitpid) pids)
+          (error "compressed-output-port failure" pids))))))
+
 
 ;;;
 ;;; Nixpkgs.
diff --git a/tests/utils.scm b/tests/utils.scm
index adbfdf55ba..1da847689c 100644
--- a/tests/utils.scm
+++ b/tests/utils.scm
@@ -162,23 +162,16 @@
            (equal? (get-bytevector-all decompressed) data)))))
 
 (false-if-exception (delete-file temp-file))
-(test-equal "compressed-output-port + decompressed-port"
-  '((0) "Hello, compressed port!")
-  (let ((text   "Hello, compressed port!")
-        (output (open-file temp-file "w0b")))
-    (let-values (((compressed pids)
-                  (compressed-output-port 'xz output)))
-      (display text compressed)
-      (close-port compressed)
-      (close-port output)
-      (and (every (compose zero? cdr waitpid) pids)
-           (let*-values (((input)
-                          (open-file temp-file "r0b"))
-                         ((decompressed pids)
-                          (decompressed-port 'xz input)))
-             (let ((str (get-string-all decompressed)))
-               (list (map (compose cdr waitpid) pids)
-                     str)))))))
+(test-assert "compressed-output-port + decompressed-port"
+  (let* ((file (search-path %load-path "guix/derivations.scm"))
+         (data (call-with-input-file file get-bytevector-all)))
+    (call-with-compressed-output-port 'xz (open-file temp-file "w0b")
+      (lambda (compressed)
+        (put-bytevector compressed data)))
+
+    (bytevector=? data
+                  (call-with-decompressed-port 'xz (open-file temp-file "r0b")
+                    get-bytevector-all))))
 
 (false-if-exception (delete-file temp-file))
 (test-equal "fcntl-flock wait"
-- 
cgit v1.2.3