Skip to content

Commit

Permalink
Make it possible to provide a default option
Browse files Browse the repository at this point in the history 
This closes #17.
  • Loading branch information
@libre-man
libre-man committed May 23, 2020
1 parent e14c9b5 commit 9dbe15e
Show file tree
Hide file tree
Showing 3 changed files with 154 additions and 47 deletions.
5 changes: 5 additions & 0 deletions README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,11 @@ containing various parameters. Here we enumerate all allowed parameters:
* `:required`—whether the option is required. This only makes sense if the
option takes an argument.

* `:default`—the default value used if the option was not found. This can either
be a function (which will be called to generate the default value) or a
literal value. This option cannot be combined with `:required`. The default
value will not be provided to the `arg-parser`.

----

```
Expand Down
122 changes: 92 additions & 30 deletions tests.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,26 +25,32 @@

(in-package #:unix-opts)

(define-opts
(:name :grab-int
:description "grab integer INT"
:short #\i
:long "grab-int"
:required t
:arg-parser #'parse-integer
:meta-var "INT")
(:name :grab-str
:description "grab string STR"
:short #\s
:long "grab-str"
:arg-parser #'identity
:meta-var "STR")
(:name :flag-a
:description "flag with short form only"
:short #\a)
(:name :flag-b
:description "flag with long form only"
:long "flag-b"))
(defun setup ()
(define-opts
(:name :grab-int
:description "grab integer INT"
:short #\i
:long "grab-int"
:required t
:arg-parser #'parse-integer
:meta-var "INT")
(:name :grab-str
:description "grab string STR"
:short #\s
:long "grab-str"
:arg-parser #'identity
:meta-var "STR")
(:name :flag-a
:description "flag with short form only"
:short #\a)
(:name :flag-b
:description "flag with long form only"
:long "flag-b")
(:name :flag-c
:description "flag with default value"
:long "flag-c"
:arg-parser #'identity
:default (lambda () (list 1 2)))))

;;; Here is some variables that we will use and functions to reset them.

Expand Down Expand Up @@ -75,6 +81,16 @@ aspects of the tests."
*missing-arg-options* (nreverse *missing-arg-options*)
*malformed-arguments* (nreverse *malformed-arguments*)))

(defmacro with-muffled-warning (warning muffled-form &body body)
`(let ((,warning nil))
(handler-bind ((warning (lambda (warn)
(setf ,warning warn)
(let ((muffle (find-restart 'muffle-warning warn)))
(when muffle
(invoke-restart (find-restart 'muffle-warning)))))))
,muffled-form)
,@body))

;;; The tests themselves.

(defun parse-opts (opts &key unknown-option missing-arg arg-parser-failed missing-required)
Expand Down Expand Up @@ -110,14 +126,15 @@ recommended to supply them all if you don't want to end in the debugger."
(defun run-tests ()
"Run Unix-opts tests. Signal failure if any test fails and return NIL
otherwise."
(setup)
(assert (typep (argv) 'list))

(multiple-value-bind (options free-args)
(parse-opts '("--grab-int" "10" "--rere" "11" "-s" "-a" "foo.txt")
:unknown-option '(skip-option)
:missing-arg '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-int 10 :flag-a t)))
(assert (equalp options '(:grab-int 10 :flag-a t :flag-c (1 2))))
(assert (equalp free-args '("11" "foo.txt")))
(assert (equalp *unknown-options* '("--rere")))
(assert (equalp *missing-arg-options* '("-s")))
Expand All @@ -127,7 +144,7 @@ otherwise."
:unknown-option '(skip-option)
:missing-arg '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:flag-a t :grab-int 13 :flag-b t :flag-b t)))
(assert (equalp options '(:flag-a t :grab-int 13 :flag-b t :flag-b t :flag-c (1 2))))
(assert (equalp free-args '("foo.txt" "bar.txt")))
(assert (equalp *unknown-options* '("-r")))
(assert (equalp *missing-arg-options* '("-s")))
Expand All @@ -137,7 +154,7 @@ otherwise."
:unknown-option '(skip-option)
:missing-arg '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-str "fooba" :grab-int 100)))
(assert (equalp options '(:grab-str "fooba" :grab-int 100 :flag-c (1 2))))
(assert (equalp free-args '("-")))
(assert (equalp *unknown-options* '("--roro")))
(assert (equalp *missing-arg-options* nil))
Expand All @@ -147,8 +164,10 @@ otherwise."
:unknown-option '(use-value "--grab-int")
:missing-arg '(use-value "my-string")
:arg-parser-failed '(reparse-arg "15"))
(assert (equalp options '(:grab-int 15 :grab-str "my-string"
:grab-int "my-string")))
(assert (equalp options '(:grab-int 15
:grab-str "my-string"
:grab-int "my-string"
:flag-c (1 2))))
(assert (equalp free-args nil))
(assert (equalp *unknown-options* '("--foobar" "-l")))
(assert (equalp *missing-arg-options* '("-s" "--grab-int")))
Expand All @@ -158,7 +177,7 @@ otherwise."
:unknown-option '(skip-option)
:missing-arg '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-int 10)))
(assert (equalp options '(:grab-int 10 :flag-c (1 2))))
(assert (equalp free-args '("14")))
(assert (equalp *unknown-options* '("--grab")))
(assert (equalp *missing-arg-options* '("--grab-s")))
Expand All @@ -168,7 +187,7 @@ otherwise."
:unknown-option '(skip-option)
:missing-arg '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-int 15)))
(assert (equalp options '(:grab-int 15 :flag-c (1 2))))
(assert (equalp free-args '("--grab-int" "16")))
(assert (equalp *unknown-options* nil))
(assert (equalp *missing-arg-options* nil))
Expand All @@ -179,7 +198,7 @@ otherwise."
:missing-arg '(skip-option)
:missing-required '(skip-option)
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-str "5")))
(assert (equalp options '(:grab-str "5" :flag-c (1 2))))
(assert (equalp free-args '()))
(assert (equalp *missing-required-options* '((:grab-int))))
(assert (equalp *unknown-options* nil))
Expand All @@ -191,12 +210,34 @@ otherwise."
:missing-arg '(skip-option)
:missing-required '(use-value (15))
:arg-parser-failed '(skip-option))
(assert (equalp options '(:grab-str "5" :grab-int 15)))
(assert (equalp options '(:grab-str "5" :grab-int 15 :flag-c (1 2))))
(assert (equalp free-args '()))
(assert (equalp *missing-required-options* '((:grab-int))))
(assert (equalp *unknown-options* nil))
(assert (equalp *missing-arg-options* nil))
(assert (equalp *malformed-arguments* nil)))

;; If options with a default value are provided the default value is not used.
(multiple-value-bind (options _)
(parse-opts '("--flag-c" "hello")
:missing-required '(skip-option))
(declare (ignore _))
(assert (equalp options '(:flag-c "hello"))))

(multiple-value-bind (options _)
(parse-opts '()
:missing-required '(skip-option))
(declare (ignore _))
(let ((first-value (getf options :flag-c)))
(assert (equalp first-value '(1 2)))
(multiple-value-bind (options __)
(parse-opts '()
:missing-required '(skip-option))
(declare (ignore __))
(let ((second-value (getf options :flag-c)))
(assert (not (eql first-value second-value)))
(assert (equalp first-value second-value))))))

(let ((described (with-output-to-string (s)
(describe :stream s))))
(assert (equal described (format nil "~
Expand All @@ -206,6 +247,7 @@ Available options:
-s, --grab-str STR grab string STR
-a flag with short form only
--flag-b flag with long form only
--flag-c ARG flag with default value [Default: (1 2)]
"))))
(let ((described (with-output-to-string (s)
Expand All @@ -216,7 +258,27 @@ Available options:
-s, --grab-str STR grab string STR
-a flag with short form only
--flag-b flag with long form only
--flag-c ARG flag with default value [Default: (1 2)]
"))))

;; Can also give a string value as default option.
(with-muffled-warning warning
(add-option :name :flag-d
:long "flag-d"
:arg-parser #'identity
:default "DEFAULT-FLAG-D")
(assert (not warning)))
(multiple-value-bind (options _)
(parse-opts '() :missing-required '(skip-option))
(declare (ignore _))
(assert (equal (getf options :flag-d) "DEFAULT-FLAG-D")))

")))))
;; Should warn if a mutable default variable is used.
(with-muffled-warning warning (add-option :name :flag-e
:long "flag-e"
:arg-parser #'identity
:default (list 1 2))
(assert warning)))

(export 'run-tests)
74 changes: 57 additions & 17 deletions unix-opts.lisp
View file
Original file line number Diff line number Diff line change
Expand Up @@ -77,7 +77,12 @@ parsed with this function")
:initarg :meta-var
:accessor meta-var
:documentation "if this option requires an argument, this is how it will
be printed in option description"))
be printed in option description")
(default
:initarg :default
:accessor default
:documentation "if the option is not passed this value will be used,
cannot be used in combination with REQUIRED"))
(:documentation "representation of an option"))

(define-condition troublesome-option (simple-error)
Expand Down Expand Up @@ -139,6 +144,7 @@ an argument, it's given but cannot be parsed by argument parser."))
(long (getf args :long))
(arg-parser (getf args :arg-parser))
(required (getf args :required))
(default (getf args :default))
(meta-var (getf args :meta-var "ARG")))
(unless (or short long)
(error "at least one form of the option must be provided"))
Expand All @@ -149,13 +155,23 @@ an argument, it's given but cannot be parsed by argument parser."))
(check-type arg-parser (or null function))
(check-type meta-var string)
(check-type required boolean)
(when required
(check-type default null))
(when (and default
(or (consp default) (and
(not (stringp default))
(arrayp default))
(hash-table-p default) (typep default 'standard-object)))
(warn "Providing mutable object as default value, please provide a function that returns a fresh instance of this object. ~
Default value of ~A was provided." default))
(push (make-instance 'option
:name name
:description description
:short short
:long long
:required required
:arg-parser arg-parser
:default default
:meta-var meta-var)
*options*)))

Expand Down Expand Up @@ -244,6 +260,18 @@ the program as first elements of the list. Portable across implementations."
(and (typep str 'string)
(not (optionp str))))

(defun maybe-funcall (value-or-fun)
(if (functionp value-or-fun)
(funcall value-or-fun)
value-or-fun))

(defun map-options-to-hash-table (options callback)
(loop :with table = (make-hash-table)
:for option :in options
:when (funcall callback option)
:do (setf (gethash (name option) table) option)
:finally (return table)))

(defun find-option (opt)
"Find option OPT and return object that represents it or NIL."
(multiple-value-bind (opt key)
Expand All @@ -259,7 +287,7 @@ the program as first elements of the list. Portable across implementations."
nil
(car matches))))))

(defun get-opts (&optional options)
(defun get-opts (&optional (options 'not-given))
"Parse command line options. If OPTIONS is given, it should be a list to
parse. If it's not given, the function will use `argv' function to get list
of command line arguments.
Expand Down Expand Up @@ -301,13 +329,12 @@ be used), `skip-option' (ignore all these options, effectively binding them
to `nil')"
(do ((tokens (mapcan #'split-short-opts
(mapcan #'split-on-=
(or options (cdr (argv)))))
(if (eq options 'not-given)
(cdr (argv))
options)))
(cdr tokens))
(required (loop :with table = (make-hash-table)
:for option :in *options*
:when (required option)
:do (setf (gethash (name option) table) option)
:finally (return table)))
(required (map-options-to-hash-table *options* #'required))
(default-values (map-options-to-hash-table *options* #'default))
poption-name
poption-raw
poption-parser
Expand All @@ -328,6 +355,10 @@ to `nil')"
:for value :in values
:do (push (name option) options)
:do (push value options))))))
(loop :for option :being :the :hash-values :of default-values
:do (progn
(push (name option) options)
(push (maybe-funcall (default option)) options)))
(values (nreverse options)
(nreverse free-args))))
(labels ((push-option (name value)
Expand All @@ -353,13 +384,15 @@ to `nil')"
(process-option (opt)
(let ((option (find-option opt)))
(if option
(let ((parser (arg-parser option)))
(progn
(remhash (name option) required)
(if parser
(setf poption-name (name option)
poption-raw opt
poption-parser parser)
(push-option (name option) t)))
(remhash (name option) default-values)
(let ((parser (arg-parser option)))
(if parser
(setf poption-name (name option)
poption-raw opt
poption-parser parser)
(push-option (name option) t))))
(restart-case
(error 'unknown-option
:option opt)
Expand Down Expand Up @@ -418,16 +451,23 @@ text is wider than ARGUMENT-BLOCK-WIDTH."
:initial-element #\Space))))
(let* ((option-strings (mapcar
(lambda (opt)
(with-slots (short long description required arg-parser meta-var) opt
(with-slots (short long description required arg-parser meta-var default) opt
(let ((opts-and-meta
(concatenate
'string
(if short (format nil "-~c" short) "")
(if (and short long) ", " "")
(if long (format nil "--~a" long) "")
(if arg-parser (format nil " ~a" meta-var) "")
(if required (format nil " (Required)") ""))))
(cons opts-and-meta description))))
(if required (format nil " (Required)") "")))
(full-description
(concatenate
'string
description
(if default
(format nil " [Default: ~A]" (maybe-funcall default))
""))))
(cons opts-and-meta full-description))))
*options*))
(max-opts-length (reduce #'max
(mapcar (lambda (el)
Expand Down

0 comments on commit 9dbe15e

Please sign in to comment.