(require-extension srfi-13 posix test getopt-long matchable ) (define (symbol-upcase str) (string->symbol (string-upcase str))) (define grammar1 `((lockfile-dir (required #t) (value #t) (single-char #\k) (value (required DIR) (predicate ,directory?))) (verbose (required #f) (single-char #\v) (value #f)) (x-includes (single-char #\x) (value #t)) (rnet-server (single-char #\y) (value (required SERVER) (predicate ,string?))) (help (single-char #\h)) )) ;;; (define cmdline1 '("-h" "-vk" "/tmp" "--x-includes=/usr/include" "--rnet-server=lamprod" "--" "-fred" "foo2" "foo3" )) (define opts (getopt-long cmdline1 grammar1)) (define dispatch (make-option-dispatch opts grammar1)) (test-group "grammar1" (test `((@ "-fred" "foo2" "foo3") (rnet-server . "lamprod") (x-includes . "/usr/include") (lockfile-dir . "/tmp") (verbose . #t) (help . #t)) (getopt-long cmdline1 grammar1) ) (test "lamprod" (dispatch 'rnet-server) ) ) (define opt-defaults `( (morphology-file . S) (meta-filter . (("Note" ""))) (index-fields . ("Neuron Name" "Note")) )) (define (defopt x) (alist-ref x opt-defaults)) (define grammar2 `( (data-dir "set download directory (default is a randomly generated name in /tmp)" (single-char #\d) (value (required DIR))) (morphology-file "download morphology files (Original, Standard or None, default is standard)" (single-char #\m) (value (required "O, S, or N") (default ,(defopt 'morphology-file)) (predicate ,(lambda (arg) (case (symbol-upcase arg) ((O S N ORIGINAL STANDARD) #t) (else #f)))) (transformer ,symbol-upcase))) (meta-filter "filter pages based on metadata" (single-char #\f) (value (required "NAME1=REGEXP1[,NAME2!=REGEXP2 ...]") (default ,(defopt 'meta-filter)) (transformer ,(lambda (arg) (map (lambda (x) (match (string-split x "!=") ((n v) `(!= . ,(map string-trim-both (list n v)))) (else (begin (match (string-split x "=") ((n v ) `(= . ,(map string-trim-both (list n v)))) ((n) `(= ,(string-trim-both n) ""))))))) (string-split arg ","))) ))) (print-metadata "print metadata" (single-char #\p)) (i "make index file") (index-fields ,(begin (string-append "comma-separated list of index fields " "(default is " (string-intersperse (defopt 'index-fields) ", ") ")") ) (value (required "FIELD1,...") (default ,(defopt 'index-fields)) (transformer ,(lambda (arg) (map string-trim-both (string-split (or arg "") ",")))))) (help "Print help" (single-char #\h)) )) (define cmdline2 '("--meta-filter=\"Note=,Archive Name=Brown\"" "-d" "data" "FormSubmit.html")) (test-group "grammar2" (test `((@ "FormSubmit.html") (data-dir . "data") (meta-filter (= "Note" "") (!= "Archive Name" "Brown"))) (getopt-long cmdline2 grammar2) ) ) (test-group "uknown option" (test (list "u") (let-values (((_ unknown) (getopt-long '("-u") grammar2 unknown-option-handler: (lambda (x) x)))) unknown)) ) (test-exit)