;;
;; command-line.scm
;;
;; Argument parsing on command-line with interpreter -- support.
;;
;; ISC License
;;
;; Copyright 2023 Brmlab, z.s.
;; Dominik Pantůček <dominik.pantucek@trustica.cz>
;;
;; Permission to use, copy, modify, and/or distribute this software
;; for any purpose with or without fee is hereby granted, provided
;; that the above copyright notice and this permission notice appear
;; in all copies.
;; 
;; THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
;; WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
;; WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE
;; AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
;; CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS
;; OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT,
;; NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;

(module
 command-line
 (command-line
  command-line-tests!)

 (import scheme
	 (chicken base)
	 (chicken process-context)
	 testing)

 ;; Consumes given number of arguments from the list and returns the
 ;; remainder of the list and a list of arguments consumed.
 (define (consume-args args num)
   (let loop ((args args)
	      (res '())
	      (num num))
     (if (= num 0)
	 (list args (reverse res))
	 (if (null? args)
	     (error 'consume-args "Not enough arguments" num)
	     (loop (cdr args)
		   (cons (car args) res)
		   (- num 1))))))

 ;; Gets command-line arguments after the "--" of csi (not useful when
 ;; compiled)
 (define (get-command-line-arguments . explicit-argv)
   (let* ((args (if (null? explicit-argv) (argv) explicit-argv))
	  (rargs (member "--" args)))
     (if rargs
	 (cdr rargs)
	 (cdr args))))

 (define (parse-command-line specs)
   #f)

 (define-syntax make-option
   (syntax-rules ()
     ((_ opt help (args ...) body ...)
      (list (symbol->string 'opt)
	    help
	    (lambda (args ...) body ...)))
     ((_ opt help proc)
      (list (symbol->string 'opt) help proc))
     ((_ opt help)
      (list (symbol->string 'opt help 'help)))))

 (define-syntax command-line
   (syntax-rules ()
     ((_ ((exps ...) ...))
      (parse-command-line
       (list (make-option exps ...) ...)))))

 ;; Performs self-tests of the command-line module
 (define (command-line-tests!)
   (run-tests
    command-line
    (test-exn consume-args (consume-args '(1 2 3) 4))
    (test-equal? consume-args (consume-args '(1 2 3 4) 2) '((3 4) (1 2)))
    (test-equal? get-command-line-arguments (get-command-line-arguments 1 2 3) '(2 3))
    (test-equal? get-command-line-arguments (get-command-line-arguments 1 "--" 2 3) '(2 3))
    ))

 )