;;; Gash --- Guile As SHell
;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;;
;;; This file is part of Gash.
;;;
;;; Gash 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.
;;;
;;; Gash 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 Gash.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;;; Code:

(define-module (gash gzip)
  #:use-module (gash compat)
  #:use-module (weinholt compression gzip)
  #:use-module (ice-9 control)
  #:use-module (srfi srfi-37)
  #:export (gunzip-file
            gunzip-port))

(define *program-name* "gzip (GASH)")

(if-guile-version-below (2 0 15)
  (begin
    ;; ERROR: invalid or unknown character encoding "ISO-8859-1"
    (define %encoding-none "ascii"))
  (begin
    (define %encoding-none "ISO-8859-1")))

(define (_ msg . rest)
  msg)

(define (error* status msg . args)
  (force-output)
  (let ((port (current-error-port)))
    (when *program-name*
      (display *program-name* port)
      (display ": " port))
    (apply format port msg args)
    (newline port)
    (unless (zero? status)
      ;; This call to 'abort' causes 'main' to immediately return the
      ;; specified status value.  Similar to 'exit' but more
      ;; controlled, for example, when using the REPL to debug,
      ;; 'abort' will not cause the entire process to terminate.
      ;;
      ;; This is also handy to attempt processing every file, even
      ;; after an error has occured.  To do this, establish another
      ;; prompt at an interesting place inside 'main'.
      (abort (lambda (k)
               status)))))

(define (make-file-error-handler filename)
  (lambda args
    (error* 1 (_ "~a: ~a")
            filename
            (strerror (system-error-errno args)))))

(define (system-error-handler key subr msg args rest)
  (apply error* 1 msg args))

(define (gunzip-port in out verbose?)
  (set-port-encoding! in %encoding-none)
  (set-port-encoding! out %encoding-none)
  (setvbuf in 'block 65536)
  (setvbuf out 'block 65536)
  (extract-gzip in out))

(define (gunzip-file infile verbose?)
  (catch 'system-error
    (lambda ()
      (let ((outfile (string-drop-right infile 3)))
        (when (not (string-suffix? ".gz" infile))
          (error* 1 (_ "~a: does not have .gz suffix") infile))
        (when (file-exists? outfile)
          (error* 1 (_ "~a: already exists") outfile))
        (let ((in (open-file infile "rb"))
              (out (open-file outfile "wb")))
          (gunzip-port in out verbose?)
          (for-each close-port (list in out))
          (delete-file infile))))
    system-error-handler))
