;;;   tools for parsing command line options
;;;
;;; Author: Max-Gerd Retzlaff <m.retzlaff@gmx.net>

(defpackage #:parse-command-line-options
  (:use #:cl)
  (:export #:command-line-option-p #:get-command-line-argument
           #:with-command-line-options
           #:make-argument-list))

(in-package :parse-command-line-options)

(defun command-line-option-p (&rest parameter-names)
  "returns the position of the rightmost command-line parameter of PARAMETER-NAMES"
  (flet ((position-of-option (parameter-name)
           (position parameter-name sb-ext:*posix-argv* :test #'string-equal)))
    (let ((positions (remove nil (mapcar #'position-of-option parameter-names))))
      (when positions ;; list might be empty!
            (apply #'max positions)))))

(defun get-command-line-argument (&rest argument-names)
  (let ((position (apply #'command-line-option-p argument-names)))
    (when (and position
               (<= (+ 2 position) ;; there is an argument after its name
                   (length sb-ext:*posix-argv*)))
      (nth (1+ position) sb-ext:*posix-argv*))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun symbol-to-option-name (symbol)
    (concatenate 'string "--" (string-downcase (symbol-name symbol))))

  (defun parse-option-specs (variables-and-maybe-option-names)
    (loop for option-spec in variables-and-maybe-option-names
          append (let (variable
                       supplied-p-variable
                       option-names)
                   (if (consp option-spec)
                       (setf option-names (rest option-spec)
                             variable (first option-spec))
                       (setf variable option-spec))
                   (setf supplied-p-variable (intern (format nil "~a-SUPPLIED-P" variable)))
                   (unless option-names
                     (setf option-names (list (symbol-to-option-name variable))))
                   `((,variable (get-command-line-argument ,@option-names))
                     (,supplied-p-variable (command-line-option-p ,@option-names)))))))
  
(defmacro with-command-line-options ((&rest variables-and-maybe-option-names) &body body)
  (let ((option-specs (parse-option-specs variables-and-maybe-option-names)))
    `(let ,option-specs
       (declare (ignorable ,@(mapcar #'first option-specs)))
       ,@body)))


(defmacro make-argument-list (&rest specs)
  "a macro that helps making keyword argument lists from command-line options;
  example-call:
    (let ((write-file-supplied-p nil)
          (foo-file \"/tmp/foo\")
          (foo-file-supplied-p t))
      (make-argument-list
        (:write-output-p write-file-supplied-p)
        (:foo-pathname foo-file foo-file-supplied-p)))
   =>
    (:FOO-PATHNAME \"/tmp/foo\" :WRITE-OUTPUT-P NIL)"
  (flet ((length>2 (list)
           (< 2 (length list))))
    (let ((argument-list (gensym "ARGUMENT-LIST"))
          (specs-without-supplied-p (remove-if #'length>2 specs))
          (specs-with-supplied-p (remove-if-not #'length>2 specs)))
      `(let ((,argument-list (list ,@(apply #'append specs-without-supplied-p))))
         ,@(loop for (keyword value supplied-p) in (reverse specs-with-supplied-p)
                 collect `(when ,supplied-p
                            (push ,value ,argument-list)
                            (push ,keyword ,argument-list)))
         ,argument-list))))