;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Mathieu Othacehe <othacehe@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu compression)
  #:use-module (guix gexp)
  #:use-module (guix ui)
  #:use-module ((gnu packages compression) #:hide (zip))
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (ice-9 match)
  #:export (compressor
            compressor?
            compressor-name
            compressor-extension
            compressor-command
            %compressors
            lookup-compressor))

;; Type of a compression tool.
(define-record-type <compressor>
  (compressor name extension command)
  compressor?
  (name       compressor-name)      ;string (e.g., "gzip")
  (extension  compressor-extension) ;string (e.g., ".lz")
  (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
                                    ;                    "-9n" ))

(define %compressors
  ;; Available compression tools.
  (list (compressor "gzip"  ".gz"
                    #~(list #+(file-append gzip "/bin/gzip") "-9n"))
        (compressor "lzip"  ".lz"
                    #~(list #+(file-append lzip "/bin/lzip") "-9"))
        (compressor "xz"    ".xz"
                    #~(append (list #+(file-append xz "/bin/xz")
                                    "-e")
                              (%xz-parallel-args)))
        (compressor "bzip2" ".bz2"
                    #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
        (compressor "zstd" ".zst"
                    ;; The default level 3 compresses better than gzip in a
                    ;; fraction of the time, while the highest level 19
                    ;; (de)compresses more slowly and worse than xz.
                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
        (compressor "none" "" #f)))

(define (lookup-compressor name)
  "Return the compressor object called NAME.  Error out if it could not be
found."
  (or (find (match-lambda
              (($ <compressor> name*)
               (string=? name* name)))
            %compressors)
      (leave (G_ "~a: compressor not found~%") name)))
lkit.scm?id=51b1d5398793bf717a9d2cb6478efc7a173754fa'>gnu: polkit-qt: Use modular qt.</a><span class='msg-avail'>...</span></td><td>David Craven</td></tr>
<tr><td><span title='2016-04-14 10:38:21 +0300'>2016-04-14</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=fc1adab1487e5ea3c5f6341263df14414ba4e784'>gnu: packages: Use 'search-patches' everywhere.</a><span class='msg-avail'>...</span></td><td>Alex Kost</td></tr>
<tr><td><span title='2016-02-27 08:49:26 -0500'>2016-02-27</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=b35461748b20d0172744974b39e7d9d033400c51'>gnu: Fix misplaced commas (unquote).</a><span class='msg-avail'>...</span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2016-02-21 21:11:49 +0100'>2016-02-21</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=5cc3096c739c404a801d62aafb5f664bc3a766fb'>Update all sources from freedesktop.org to use https</a><span class='msg-avail'>...</span></td><td>Andy Wingo</td></tr>
<tr><td><span title='2016-02-15 20:22:28 +0200'>2016-02-15</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=7fe8ad7616dc996b57e72426e813a36d9ed201b1'>gnu: polkit-qt: Build with qt-5.</a><span class='msg-avail'>...</span></td><td>Efraim Flashner</td></tr>
<tr><td><span title='2015-11-01 17:56:47 +0100'>2015-11-01</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=222e3319bd9e942070be57933a50996e3c73cb39'>services: 'polkit-service-type' can now be extended.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-09-02 22:34:49 +0200'>2015-09-02</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=3f130e42e0237451503a19293fe60daa27853af0'>gnu: polkit: Look for rules in /run/current-system/profile.</a><span class='msg-avail'>...</span></td><td>Andy Wingo</td></tr>
<tr><td><span title='2015-09-02 22:34:12 +0200'>2015-09-02</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=7b6c5c5d74fcb69b04929e7f5b2988adbeebcf2f'>gnu: polkit: Use elogind for seat management.</a><span class='msg-avail'>...</span></td><td>Andy Wingo</td></tr>
<tr><td><span title='2015-08-18 23:56:17 -0400'>2015-08-18</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=89a39d4e761fa13673c669770228d3e84fdafeb7'>Revert "PRELIMINARY: gnu: polkit: Work on making it functional in practice."</a><span class='msg-avail'>...</span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2015-08-18 23:52:57 -0400'>2015-08-18</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=e640340b9ec6c601720977820b2701d6cd99b74c'>PRELIMINARY: gnu: polkit: Work on making it functional in practice.</a></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2015-07-11 19:03:19 -0400'>2015-07-11</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=c7bdc6bb7dbab065d07f887db37909081e1703f5'>gnu: polkit: Update to 0.113.</a><span class='msg-avail'>...</span></td><td>Mark H Weaver</td></tr>
<tr><td><span title='2015-05-01 17:38:44 +0200'>2015-05-01</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=cb151c68bfdb207d6029402c4a1c004ebd630d68'>gnu: polkit-qt: Add $libdir to RUNPATH.</a><span class='msg-avail'>...</span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2015-01-11 19:14:53 +0800'>2015-01-11</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=4923e06f2168632d1ef40bfcd1b36a43de85e561'>gnu: Move mozjs and nspr to (gnu packages gnuzilla).</a><span class='msg-avail'>...</span></td><td>宋文武</td></tr>
<tr><td><span title='2014-11-11 10:51:52 +0100'>2014-11-11</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=b118401f7126469a8cadae81876e21aa93657a79'>gnu: polkit: Propagate input glib.</a><span class='msg-avail'>...</span></td><td>Andreas Enge</td></tr>
<tr><td><span title='2014-11-10 13:15:25 +0100'>2014-11-10</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=054a3921f09e6670522030829d6367cb1275ba7a'>gnu: Add polkit-qt.</a><span class='msg-avail'>...</span></td><td>Andreas Enge</td></tr>
<tr><td><span title='2014-11-09 18:55:31 +0100'>2014-11-09</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=c4bd2aca00068c179c308256e6a8c04d7d3e108e'>gnu: Add polkit.</a><span class='msg-avail'>...</span></td><td>Andreas Enge</td></tr>
<tr><td><span title='2014-11-09 11:09:12 +0100'>2014-11-09</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=922ea80683fa9ba5cc91818d2e2679b5c6c1fa6a'>gnu: Add nspr.</a><span class='msg-avail'>...</span></td><td>Andreas Enge</td></tr>
<tr><td><span title='2014-11-08 13:24:21 +0100'>2014-11-08</span></td><td><a href='/guix/commit/gnu/packages/polkit.scm?id=cff1c5c1c679ea1cf94282f824277c572854bffe'>gnu: Add mozjs (Mozilla Spidermonkey).</a><span class='msg-avail'>...</span></td><td>Andreas Enge</td></tr>