;;; Gash -- Guile As SHell
;;; Copyright © 2018, 2019 Timothy Sample <samplet@ngyro.com>
;;;
;;; 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/>.

(define-module (gash built-ins read)
  #:use-module (gash compat)
  #:use-module (gash compat textual-ports)
  #:use-module (gash environment)
  #:use-module (ice-9 match)
  #:use-module (ice-9 rdelim)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26))

;;; Commentary:
;;;
;;; The 'read' utility.
;;;
;;; Code:

(define* (read-logical-line #:optional (port (current-input-port)))
  "Return a ``logical'' line from @var{port} if specified, otherwise
from the value returned by @code{(current-input-port)}.  A logical
line allows ignoring a newline character by prefixing it with a
backslash."
  (let loop ((acc '()))
    (match (get-char port)
      ((? eof-object? eof) (cons (reverse-list->string acc) eof))
      (#\newline (cons (reverse-list->string acc) #\newline))
      (#\\ (match (get-char port)
             ((? eof-object? eof) (cons (reverse-list->string acc) eof))
             (#\newline (loop acc))
             (chr (loop (cons chr acc)))))
      (chr (loop (cons chr acc))))))

;; The '(gash word)' module already has a 'split-fields' procedure.
;; However, we need to be able to specify a maximum number of fields,
;; which it cannot do.  We could extend it, but it has to deal with
;; quotes, which we do not here.  It is simpler to write a specialized
;; version that can deal with 'max' without quotes than it is to
;; extend the more general version.
(define* (split-fields str max hard-delims soft-delims
                       #:optional (start 0) (end (string-length str)))
  "Split @var{str} into at most @var{max} fields.  Each individual
occurrence of a character in the set @var{hard-delims} delimits a
field, while contiguous sequences of characters from the set
@var{soft-delims} are treated as a single delimiter."
  (define non-soft-delims (char-set-complement soft-delims))
  (define all-delims (char-set-union hard-delims soft-delims))

  (define* (field+next-index str i)
    (let* ((end* (or (string-index str all-delims i end) end))
           (start* (string-index str non-soft-delims end* end)))
      (values (substring str i end*)
              (if (and start*
                       (char-set-contains? hard-delims
                                           (string-ref str start*)))
                  (or (string-index str non-soft-delims (1+ start*) end) end)
                  start*))))

  (cond
   ((string-index str non-soft-delims start end)
    => (lambda (start*)
         (let loop ((i start*) (count 0) (acc '()))
           (if (>= count (1- max))
               (reverse! (cons (string-trim-right str soft-delims i end) acc))
               (call-with-values (lambda () (field+next-index str i))
                 (lambda (field i*)
                   (if i*
                       (loop i* (1+ count) (cons field acc))
                       (reverse! (cons field acc)))))))))
   (else '())))

(define (main . args)
  (match-let* (((vars . get-line)
                (match args
                  (("-r" vars ...)
                   (cons vars (cut read-line (current-input-port) 'split)))
                  ((vars ...)
                   (cons vars read-logical-line))))
               (limit (length vars))
               ((line . delimiter) (get-line))
               (dflt (string #\space #\tab #\newline))
               (ifs (string->char-set (getvar "IFS" dflt)))
               (ifs/w (char-set-intersection ifs char-set:whitespace))
               (ifs/nw (char-set-difference ifs char-set:whitespace))
               (fields (split-fields line limit ifs/nw ifs/w)))
    (for-each (lambda (var field)
                ;; XXX: Verify that VAR is a valid variable name.
                (setvar! var field))
              vars
              (append fields (circular-list "")))
    (if (eof-object? delimiter)
        EXIT_FAILURE
        EXIT_SUCCESS)))
