;;; Guix Package File for Gash
;;; Copyright © 2017, 2018, 2019 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is free software; as a special exception the author gives
;;; unlimited permission to copy and/or distribute it, with or without
;;; modifications, as long as this notice is preserved.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY, to the extent permitted by law; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

(use-modules (git)
             (gnu packages)
             (gnu packages autotools)
             (gnu packages code)
             (gnu packages guile)
             (gnu packages pkg-config)
             (gnu packages texinfo)
             (gnu packages version-control)
             (guix build utils)
             (guix build-system gnu)
             (guix download)
             (guix gexp)
             ((guix licenses) #:prefix license:)
             (guix packages)
             (guix utils)
             (ice-9 popen)
             (ice-9 textual-ports))

(define *srcdir* (canonicalize-path (current-source-directory)))

(define *version*
  (with-directory-excursion *srcdir*
    (let* ((script "./build-aux/git-version-gen")
           (pipe (open-pipe* OPEN_READ script ".tarball-version"))
           (version (get-string-all pipe)))
      (close-pipe pipe)
      version)))

(define (make-select)
  (define paths
    (or (false-if-exception
         (let* ((directory (repository-discover *srcdir*))
                (repository (repository-open directory))
                (oid (reference-target (repository-head repository)))
                (commit (commit-lookup repository oid))
                (tree (commit-tree commit)))
           (tree-list tree)))
        (false-if-exception
         (with-directory-excursion *srcdir*
           (call-with-input-file ".tarball-manifest"
             (lambda (port)
               (let loop ((line (get-line port)) (acc '()))
                 (if (eof-object? line)
                     acc
                     (loop (get-line port) (cons line acc))))))))
        (error "Cannot make file selector")))
  (lambda (file stat)
    (let ((relative (substring file (1+ (string-length *srcdir*)))))
      (or (string=? relative ".git")
          (string-prefix? ".git/" relative)
          (member relative paths)))))

(define guile-2.0.9
  (package
    (inherit guile-2.0)
    (version "2.0.9")
    (source
     (origin
       (method url-fetch)
       (uri (string-append "mirror://gnu/guile/guile-" version ".tar.xz"))
       (sha256
        (base32
         "0nw9y8vjyz4r61v06p9msks5lm58pd91irmzg4k487vmv743h2pp"))))
    (arguments
     (substitute-keyword-arguments (package-arguments guile-2.0)
       ;; XXX: There are some encoding and network test failures.
       ((#:tests? _ #f) #f)))))

(package
  (name "gash")
  (version *version*)
  (source (local-file *srcdir* #:recursive? #t #:select? (make-select)))
  (build-system gnu-build-system)
  (native-inputs
   `(("autoconf" ,autoconf)
     ("automake" ,automake)
     ("git" ,git-minimal)
     ("lcov" ,lcov)                ; For generating test coverage data
     ("pkg-config" ,pkg-config)
     ("texinfo" ,texinfo)))
  (inputs
   `(("guile" ,guile-3.0)))
  (home-page "https://savannah.nongnu.org/projects/gash/")
  (synopsis "POSIX-compatible shell written in Guile Scheme")
  (description "Gash is a POSIX-compatible shell written in Guile
Scheme.  It is designed to be capable of bootstrapping Bash.")
  (license license:gpl3+))