;; ref impl is at http://memebeam.org/free-software/args-fold/

(import (chicken load))
(load-relative "../srfi-37")
(import srfi-37 test)

(define (cons-option option name arg options operands)
  (values (cons (cons name arg) options)
          operands))
(define (cons-option/check-required option name arg options operands)
  ;; Can only be detected if it's the last one on the command-line
  (when (and (not arg)
             (option-required-arg? option))
    (error "option requires an argument" name))
  (values (cons (cons name arg) options)
          operands))
(define (cons-operand operand options operands)
  (values options
          (cons operand operands)))

(test
 '((("foo" . #f) ("bar" . "bat") (#\i . "infile") (#\v . #f) (#\v . #f) (#\n . #f) (#\o . "outfile"))
   ("file1" "file2" "file3"))
 (receive (opt oper)
     (args-fold
      '("--foo" "--bar=bat" "-i" "infile" "-v" "file1" "-vn" "-o" "outfile" "file2" "file3")
      (list (option '(#\v) #f #f cons-option)
            (option '(#\n) #f #f cons-option)
            (option '(#\i) #t #f cons-option)
            (option '(#\o) #t #f cons-option)
            (option '("foo") #f #f cons-option)
            (option '("bar") #t #f cons-option))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test                        ; yuck
 '((("foo" . "file1")) ())
 (receive (opt oper)
     (args-fold
      '("--foo" "file1")
      (list (option '("foo") #t #f cons-option))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test                        ; yuck
 '((("foo" . #f)) ())
 (receive (opt oper)
     (args-fold
      '("--foo")
      (list (option '("foo") #t #f cons-option))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "non-argument option ignores argument separated by space"
 '((("foo" . #f)) ("file1"))
 (receive (opt oper)
     (args-fold
      '("--foo" "file1")
      (list (option '("foo") #f #f cons-option))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "non-argument option accepts argument separated by = (broken?)"
 '((("foo" . "file1")) ())
 (receive (opt oper)
     (args-fold
      '("--foo=file1")
      (list (option '("foo") #f #f cons-option))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Required options eat next argument even if looks like long option"
 '((("foo" . "--bar")) ())
 (receive (opt oper)
     (args-fold
      '("--foo" "--bar")
      (list (option '("foo") #t #f cons-option/check-required)
            (option '("bar") #f #f cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test-error
 "Required-arg option arg missing throws error in last position"
;;  '((("foo" . #f)))
 (receive (opt oper)
     (args-fold
      '("--foo")
      (list (option '("foo") #t #f cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg long option --foo=3"
 '((("foo" . "3")) ())
 (receive (opt oper)
     (args-fold
      '("--foo=3")
      (list (option '("foo") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg --foo"
 '((("foo" . #f)) ())
 (receive (opt oper)
     (args-fold
      '("--foo")
      (list (option '("foo") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg --foo --bar"
 '((("foo" . #f) ("bar" . #f)) ())
 (receive (opt oper)
     (args-fold
      '("--foo" "--bar")
      (list (option '("foo") #f #t cons-option/check-required)
            (option '("bar") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg --foo 3 -> option --foo arg #f, operand 3"
 '((("foo" . #f)) ("3"))
 (receive (opt oper)
     (args-fold
      '("--foo" "3")
      (list (option '("foo") #f #t cons-option/check-required)
            (option '("bar") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg -f 3 -> option -f arg #f, operand 3 (broken!)"
 '(((#\f . #f)) ("3"))
 (receive (opt oper)
     (args-fold
      '("-f" "3")
      (list (option '(#\f) #f #t cons-option/check-required)
            (option '("bar") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Optional-arg -f=3 -> option -f arg =3"
 '(((#\f . "=3"))())
 (receive (opt oper)
     (args-fold
      '("-f=3")
      (list (option '(#\f) #f #t cons-option/check-required)
            (option '("bar") #f #t cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test
 "Required-arg -f 3 -> option -f arg 3"
 '(((#\f . "3")) ())
 (receive (opt oper)
     (args-fold
      '("-f" "3")
      (list (option '(#\f) #t #f cons-option/check-required))
      (lambda (option name args . seeds)
        (error "unrecognized option" name))
      cons-operand
      '()
      '())
   (list
    (reverse opt)
    (reverse oper))))

(test-exit)