;;;; getopt-utils-test.scm

(import test)

(import (only (chicken format) format))
(import (test-utils gloss))

;;;

(test-begin "getopt-utils")

(import (chicken pretty-print))
(import getopt-utils)

;;

(define truepred? (constantly #t))

(define-constant DEF-DB-PATHNAME "development.sqlite3")
(define-constant DEF-LS-PATHNAME "Artist list.csv")
(define-constant DEF-IM-PATHNAME "curr-images-artists")

(define +loadall?+ #f)
(define +et-directory+)
(define +ls-pathname+)
(define +db-pathname+)
(define +im-directory+)

(define (print-results)
  (glossf "loadall?: ~S" +loadall?+)
  (glossf "input ls: ~S" +ls-pathname+)
  (glossf "input et: ~S" +et-directory+)
  (glossf "output im: ~S" +im-directory+)
  (glossf "output db: ~S" +db-pathname+) )

(define (processs-options params)
  (glossf "params: ~S" params)
  (opt-set! +loadall?+ 'loadall params)
  (opt-set! +et-directory+ 'et params)
  (opt-set! +ls-pathname+ 'ls params)
  (opt-set! +im-directory+ 'im params)
  (opt-set! +db-pathname+ 'db params)
  (glossf "rest: ~S" (opt-rest params)) )

(define +opt-grammar-1+ (extend-opt-grammar #t
  (loadall "assume no \"old\" entries")
  (et "entry thingy directory"
    (value
      (required ET-PATHNAME)
      (predicate ,truepred?) ) )
  (ls ,(opt-docstring "artist list CSV pathname" DEF-LS-PATHNAME)
    (value
      (optional LS-PATHNAME)
      (predicate ,truepred?) ) )
  (im ,(opt-docstring "artist images directory" DEF-IM-PATHNAME)
    (value
      (optional IM-PATHNAME)
      (predicate ,truepred?) ) )
  (db ,(opt-docstring "database pathname" DEF-DB-PATHNAME)
    (value
      (optional DB-PATHNAME)
      (predicate ,truepred?) ) )
))

(define +opt-parameters-1+ '(
  (message . " <options>")
  (width . 48)
  ;(command .  "TEST")
))

(define +opt-grammar-2+ (extend-opt-grammar #t
  (loadall "assume no \"old\" entries")
  (et ,@(opt-body "entry thingy directory"  (required ET-PATHNAME) truepred?))
  (ls ,@(opt-body ("artist list CSV pathname" DEF-LS-PATHNAME) (optional LS-PATHNAME) truepred?))
  (im ,@(opt-body ("artist images directory" DEF-IM-PATHNAME) (optional IM-PATHNAME) truepred?))
  (db ,@(opt-body ("database pathname" DEF-DB-PATHNAME) (optional DB-PATHNAME) truepred?))
))

(define +opt-parameters-2+ '(
  (message . " <options>")
  (width . 48)
  (command .  "TEST")
))

(define +opt-grammar-3+ (extend-opt-grammar #t
  ((loadall l) "assume no \"old\" entries")
  ((size s) ,@(opt-number ("sample size" 27) (required INTEGER) (conjoin integer? positive?)) )
  (et1 ,@(opt-string "entry thingy directory req" (required ET-PATHNAME) truepred?))
  ;FIXME should have a default value if opt
  (et2 ,@(opt-string "entry thingy directory opt" ET-PATHNAME truepred?))
  (ls ,@(opt-string ("artist list CSV pathname" DEF-LS-PATHNAME) LS-PATHNAME truepred?))
  (im ,@(opt-string ("artist images directory" DEF-IM-PATHNAME) IM-PATHNAME truepred?))
  (db ,@(opt-string ("database pathname" DEF-DB-PATHNAME) DB-PATHNAME truepred?))
))

(gloss "Explicit elements")
(pp +opt-grammar-1+)
(glossln)
(gloss "Element helpers")
(pp +opt-grammar-2+)
(glossln)
(gloss "Element helpers (more)")
(pp +opt-grammar-3+)

;;

(define (main args #!optional (grammer +opt-grammar-1+) (parameters +opt-parameters-1+))
  (glossf "args: ~A" args)
  (let ((params (opt-parse args grammer parameters)))
    (processs-options params)
    (print-results) ) )

;;

(begin
  (gloss)
  (main '()) )

(begin
  (gloss)
  (main '("--loadall" "--db=/foo/bar" "the" "rest")) )

(begin
  (gloss)
  (main '() +opt-grammar-2+ +opt-parameters-2+) )

(begin
  (gloss)
  (main '() +opt-grammar-3+) )

(begin
  (gloss)
  (main '("-s" "64" "--loadall" "--db=/foo/bar" "the" "rest") +opt-grammar-3+) )

#; ;FIXME need failure test(s)
(begin
  (gloss)
  (main '("-loadall" "-db=/foo/bar")) )

;;

#; ;UNUSED
(test-group "getters"

  (test-group "basic"
    (define procs? (list-of? procedure?))
    (define (test-nprocs n x)
      (test-assert (procs? x))
      (test n (length x)) )

    (test-nprocs 5 (opt-getters +opt-grammar-1+))
    (test-nprocs 7 (opt-getters +opt-grammar-3+))

    (test-nprocs 2 (opt-getters (foo bar)))
    ;XXX (test-nprocs 2 (opt-getters '(foo bar)))
    ;XXX (test-nprocs 2 (opt-getters (list 'foo 'bar)))
  )
)

;;

#| ;XXX what was to be tested?
(import getopt-long)

(define (Xmake-option-dispatch params grammar)
)

(define (Xprocesss-options opt-get)
  (set! +loadall?+ (opt-get 'loadall))
  (set! +et-directory+ (opt-get 'et))
  (set! +ls-pathname+ (opt-get 'ls))
  (set! +im-directory+ (opt-get 'im))
  (set! +db-pathname+ (opt-get 'db)))

(define (Xmain args)
  (glossf "args: ~S" args)
  (let ((params (opt-parse args +opt-grammar-1+ +opt-parameters-1+)))
    (define opt-get (Xmake-option-dispatch params +opt-grammar-1+))
    (Xprocesss-options opt-get)
    (print-results) ) )

(print)
(Xmain '("--loadall" "--db=/foo/bar"))
|#

;;;

(test-end "getopt-utils")

(test-exit)