Browse files

Add cli/compile-option-specs

Compiled option specifications are a vector of:

{:id           Keyword  ; :server
 :short-opt    String   ; \"-s\"
 :long-opt     String   ; \"--server\"
 :required     String   ; \"HOSTNAME\"
 :desc         String   ; \"Remote server\"
 :default      Object   ; #<Inet4Address>
 :default-desc String   ; \"\"
 :parse-fn     IFn      ; #(InetAddress/getByName %)
 :assoc-fn     IFn      ; assoc
 :validate-fn  IFn      ; (partial instance? Inet4Address)
 :validate-msg String   ; \"%s is not an IPv4 host\"

The vector option spec format is desugared into the map above. All
entries are overridable, allowing for fine control of the resulting
option map after parsing an args sequence.

Additions from cli/cli include:

    :default-desc   A string that is used to represent the default
                    value, in case the string representation of the
                    default is too ugly to be printed in help output.

    :required       All options are considered boolean flags by default,
                    unless this value is truthy. The value if present
                    should be a string that will be printed as an
                    example required argument to the option.

    :validate-fn    Validates required option arguments *after* being
                    parsed by parse-fn. Exceptions are caught and return

    :validate-msg   If validate-fn returns a falsy value, validate-msg
                    is conjed onto the parse-opts :errors vector.

cli/compile-option-specs asserts the presence of an :id value in every
map, as well as the uniqueness of all :id, :short-opt, and :long-opt
  • Loading branch information...
1 parent b8103b1 commit 6e41349b2acc55ec880feab68d1340e943232a44 @guns guns committed Dec 2, 2013
Showing with 113 additions and 0 deletions.
  1. +75 −0 src/main/clojure/clojure/tools/cli.clj
  2. +38 −0 src/test/clojure/clojure/tools/cli_test.clj
@@ -205,3 +205,78 @@
(let [[options extra-args] (apply-specs specs args)
banner (with-out-str (banner-for desc specs))]
[options extra-args banner])))
+;; New API
+(def ^{:private true} spec-keys
+ [:id :short-opt :long-opt :required :desc :default :default-desc :parse-fn
+ :assoc-fn :validate-fn :validate-msg])
+(defn- compile-spec [spec]
+ (let [sopt-lopt-desc (take-while #(or (string? %) (nil? %)) spec)
+ spec-map (apply hash-map (drop (count sopt-lopt-desc) spec))
+ [short-opt long-opt desc] sopt-lopt-desc
+ long-opt (or long-opt (:long-opt spec-map))
+ [long-opt req] (when long-opt
+ (rest (re-find #"^(--[^ =]+)(?:[ =](.*))?" long-opt)))
+ id (when long-opt
+ (keyword (subs long-opt 2)))
+ [validate-fn validate-msg] (:validate spec-map)]
+ (merge {:id id
+ :short-opt short-opt
+ :long-opt long-opt
+ :required req
+ :desc desc
+ :default nil
+ :default-desc nil
+ :parse-fn nil
+ :assoc-fn nil
+ :validate-fn validate-fn
+ :validate-msg validate-msg}
+ (select-keys spec-map spec-keys))))
+(defn- distinct?* [coll]
+ (if (seq coll)
+ (apply distinct? coll)
+ true))
+(defn- compile-option-specs
+ "Map a sequence of option specification vectors to a sequence of:
+ {:id Keyword ; :server
+ :short-opt String ; \"-s\"
+ :long-opt String ; \"--server\"
+ :required String ; \"HOSTNAME\"
+ :desc String ; \"Remote server\"
+ :default Object ; #<Inet4Address>
+ :default-desc String ; \"\"
+ :parse-fn IFn ; #(InetAddress/getByName %)
+ :assoc-fn IFn ; assoc
+ :validate-fn IFn ; (partial instance? Inet4Address)
+ :validate-msg String ; \"Must be an IPv4 host\"
+ }
+ :id defaults to the keywordized name of long-opt without leading dashes, but
+ may be overridden in the option spec.
+ The option spec entry `:validate [fn msg]` desugars into the two entries
+ :validate-fn and :validate-msg.
+ An option spec may also be passed as a map containing the entries above,
+ in which case that subset of the map is transferred directly to the result
+ vector.
+ An assertion error is thrown if any :id values are unset, or if there exist
+ any duplicate :id, :short-opt, or :long-opt values."
+ [specs]
+ {:post [(every? (comp identity :id) %)
+ (distinct?* (map :id %))
+ (distinct?* (remove nil? (map :short-opt %)))
+ (distinct?* (remove nil? (map :long-opt %)))]}
+ (map (fn [spec]
+ (if (map? spec)
+ (select-keys spec spec-keys)
+ (compile-spec spec)))
+ specs))
@@ -177,3 +177,41 @@
"--" "--full" "stop"])
["-a" "-x" "ray" "-b" "-y" "yankee" "-c" "--zulu" "zebra"
"foo" "bar" "baz" "--" "--full" "stop"]))))
+(def compile-option-specs
+ #'cli/compile-option-specs)
+(deftest test-compile-option-specs
+ (testing "returns values for all keys in spec-keys"
+ (is (= (set (keys (first (compile-option-specs [["-f" "--foo" "desc"]]))))
+ (set @#'cli/spec-keys))))
+ (testing "interprets first three string arguments as short-opt, long-opt=required, and desc"
+ (is (= (map (juxt :short-opt :long-opt :required :desc)
+ (compile-option-specs [["-a" :id :alpha]
+ ["-b" "--beta"]
+ [nil nil "DESC" :id :gamma]
+ ["-f" "--foo=FOO" "desc"]]))
+ [["-a" nil nil nil]
+ ["-b" "--beta" nil nil]
+ [nil nil nil "DESC"]
+ ["-f" "--foo" "FOO" "desc"]])))
+ (testing "throws AssertionError on unset :id or duplicate :id, :short-opt, :long-opt"
+ (is (thrown? AssertionError (compile-option-specs [["-a" :id nil]])))
+ (is (thrown? AssertionError (compile-option-specs [["-a" "--alpha"] ["-b" :id :alpha]])))
+ (is (thrown? AssertionError (compile-option-specs [{:id :a :short-opt "-a"}
+ {:id :b :short-opt "-a"}])))
+ (is (thrown? AssertionError (compile-option-specs [{:id :alpha :long-opt "--alpha"}
+ {:id :beta :long-opt "--alpha"}]))))
+ (testing "desugars `--long-opt=value`"
+ (is (= (map (juxt :id :long-opt :required)
+ (compile-option-specs [[nil "--foo FOO"] [nil "--bar=BAR"]]))
+ [[:foo "--foo" "FOO"]
+ [:bar "--bar" "BAR"]])))
+ (testing "desugars :validate [fn msg]"
+ (is (= (map (juxt :validate-fn :validate-msg)
+ (compile-option-specs
+ [[nil "--name NAME" :validate [seq "Must be present"]]]))
+ [[seq "Must be present"]])))
+ (testing "accepts maps as option specs without munging values"
+ (is (= (compile-option-specs [{:id ::foo :short-opt "-f" :long-opt "--foo" :bad-key nil}])
+ [{:id ::foo :short-opt "-f" :long-opt "--foo"}]))))

0 comments on commit 6e41349

Please sign in to comment.