gnu/compression.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu compression)
  20   #:use-module (guix gexp)
  21   #:use-module (guix ui)
  22   #:use-module ((gnu packages compression) #:hide (zip))
  23   #:use-module (srfi srfi-1)
  24   #:use-module (srfi srfi-9)
  25   #:use-module (ice-9 match)
  26   #:export (compressor
  27             compressor?
  28             compressor-name
  29             compressor-extension
  30             compressor-command
  31             %compressors
  32             lookup-compressor))
  33
  34 ;; Type of a compression tool.
  35 (define-record-type <compressor>
  36   (compressor name extension command)
  37   compressor?
  38   (name       compressor-name)      ;string (e.g., "gzip")
  39   (extension  compressor-extension) ;string (e.g., ".lz")
  40   (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
  41                                     ;                    "-9n" ))
  42
  43 (define %compressors
  44   ;; Available compression tools.
  45   (list (compressor "gzip"  ".gz"
  46                     #~(list #+(file-append gzip "/bin/gzip") "-9n"))
  47         (compressor "lzip"  ".lz"
  48                     #~(list #+(file-append lzip "/bin/lzip") "-9"))
  49         (compressor "xz"    ".xz"
  50                     #~(append (list #+(file-append xz "/bin/xz")
  51                                     "-e")
  52                               (%xz-parallel-args)))
  53         (compressor "bzip2" ".bz2"
  54                     #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
  55         (compressor "zstd" ".zst"
  56                     ;; The default level 3 compresses better than gzip in a
  57                     ;; fraction of the time, while the highest level 19
  58                     ;; (de)compresses more slowly and worse than xz.
  59                     #~(list #+(file-append zstd "/bin/zstd") "-3"))
  60         (compressor "none" "" #f)))
  61
  62 (define (lookup-compressor name)
  63   "Return the compressor object called NAME.  Error out if it could not be
  64 found."
  65   (or (find (match-lambda
  66               (($ <compressor> name*)
  67                (string=? name* name)))
  68             %compressors)
  69       (leave (G_ "~a: compressor not found~%") name)))