(define-module (embddr optargs))

(import (srfi srfi-1)
        (srfi srfi-11)
        (srfi srfi-37))

(export parse-opts
        option-get)

;;;
;;; TODO: Write docs
;;;
(define (option-get opts name)
  (let ((opt (assq name opts)))
    (if opt
        (cdr opt)
        #f)))

(define (option-set opts name value)
  (if (assq name opts)
      (map (lambda (opt)
             (if (eq? (car opt) name)
                 (cons name value)
                 opt))
           opts)
      (alist-cons name value opts)))

(define (option-add opts name value)
  (if (assq name opts)
      (option-set opts name
                  (cons value
                        (option-get opts name)))
      (alist-cons name `(,value) opts)))

;;; opt-spec - '(#\o "option" [none | required | optional | multiple])
(define (parse-opts args . opt-spec)
  (args-fold
   ;; args
   args
   ;; options
   (map (lambda (spec)
          (let ((char (list-ref spec 0))
                (name (list-ref spec 1))
                (type (list-ref spec 2)))
            (let ((name-str (symbol->string name))
                  (req? (eq? type 'required))
                  (opt? (eq? type 'optional))
                  (many? (eq? type 'multiple)))
              (option (list char name-str) (or many? req?) opt?
                      (if many?
                          (lambda (opt nm arg opts rest error)
                            (values (if arg
                                        (option-add opts name arg)
                                        opts)
                                    rest
                                    error))
                          (lambda (opt nm arg opts rest error)
                            (values (option-set opts name (if arg arg #t)) rest error)))))))
        opt-spec)
   ;; unrecognized options
   (lambda (opt name arg opts rest error)
     (values opts rest #t))
   ;; operands
   (lambda (operand opts rest error)
     (values opts (cons operand rest) error))
   ;; seeds
   '() '() #f))