utils: Support zstd compression via Guile-zstd.
* guix/utils.scm (lzip-port): Return a single value. (zstd-port): New procedure. (decompressed-port, compressed-output-port): Add 'zstd' case. * tests/utils.scm (test-compression/decompression): Test 'zstd' when the (zstd) module is available.
This commit is contained in:
parent
0d04658710
commit
db0cecdf6b
@ -210,7 +210,13 @@ buffered data is lost."
|
||||
"Return the lzip port produced by calling PROC (a symbol) on PORT and ARGS.
|
||||
Raise an error if lzlib support is missing."
|
||||
(let ((make-port (module-ref (resolve-interface '(lzlib)) proc)))
|
||||
(values (make-port port) '())))
|
||||
(make-port port)))
|
||||
|
||||
(define (zstd-port proc port . args)
|
||||
"Return the zstd port produced by calling PROC (a symbol) on PORT and ARGS.
|
||||
Raise an error if zstd support is missing."
|
||||
(let ((make-port (module-ref (resolve-interface '(zstd)) proc)))
|
||||
(make-port port)))
|
||||
|
||||
(define (decompressed-port compression input)
|
||||
"Return an input port where INPUT is decompressed according to COMPRESSION,
|
||||
@ -222,6 +228,8 @@ a symbol such as 'xz."
|
||||
('gzip (filtered-port `(,%gzip "-dc") input))
|
||||
('lzip (values (lzip-port 'make-lzip-input-port input)
|
||||
'()))
|
||||
('zstd (values (zstd-port 'make-zstd-input-port input)
|
||||
'()))
|
||||
(_ (error "unsupported compression scheme" compression))))
|
||||
|
||||
(define (call-with-decompressed-port compression port proc)
|
||||
@ -281,6 +289,8 @@ program--e.g., '(\"--fast\")."
|
||||
('gzip (filtered-output-port `(,%gzip "-c" ,@options) output))
|
||||
('lzip (values (lzip-port 'make-lzip-output-port output)
|
||||
'()))
|
||||
('zstd (values (zstd-port 'make-zstd-output-port output)
|
||||
'()))
|
||||
(_ (error "unsupported compression scheme" compression))))
|
||||
|
||||
(define* (call-with-compressed-output-port compression port proc
|
||||
|
@ -228,8 +228,10 @@ skip these tests."
|
||||
get-bytevector-all)))))
|
||||
|
||||
(for-each test-compression/decompression
|
||||
'(gzip xz lzip)
|
||||
(list (const #t) (const #t) (const #t)))
|
||||
`(gzip xz lzip zstd)
|
||||
(list (const #t) (const #t) (const #t)
|
||||
(lambda ()
|
||||
(resolve-module '(zstd) #t #f #:ensure #f))))
|
||||
|
||||
;; This is actually in (guix store).
|
||||
(test-equal "store-path-package-name"
|
||||
|
Loading…
Reference in New Issue
Block a user