(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))
#: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)
filtered-port
compressed-port
decompressed-port
- compressed-output-port))
+ call-with-decompressed-port
+ compressed-output-port
+ call-with-compressed-output-port))
\f
;;;
('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
('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))))))
+
\f
;;;
;;; Nixpkgs.
(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"