Skip to content

Commit

Permalink
CLJS: Port compile-option-specs, parse-option-tokens
Browse files Browse the repository at this point in the history 
These functions ported smoothly, aside from a couple of interop
discrepancies.
  • Loading branch information
@guns
guns committed Dec 9, 2013
1 parent 7997fcc commit 8e33c0a
Show file tree
Hide file tree
Showing 2 changed files with 233 additions and 91 deletions.
138 changes: 138 additions & 0 deletions src/main/clojure/cljs/tools/cli.cljs
View file
Expand Up @@ -50,3 +50,141 @@
(recur opts (into argv (cons car cdr)) [])
(recur opts (conj argv car) cdr)))
[opts argv]))))

(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
: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 example.com/93.184.216.119>
:default-desc String ; \"example.com\"
: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.
A :default entry will not be included in the compiled spec unless specified.
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))

(defn- default-option-map [specs]
(reduce (fn [m s]
(if (contains? s :default)
(assoc m (:id s) (:default s))
m))
{} specs))

(defn- find-spec [specs opt-type opt]
(first (filter #(= opt (opt-type %)) specs)))

(defn- pr-join [& xs]
(pr-str (s/join \space xs)))

(defn- missing-required-error [opt example-required]
(str "Missing required argument for " (pr-join opt example-required)))

(defn- parse-error [opt optarg msg]
(str "Error while parsing option " (pr-join opt optarg) ": " msg))

(defn- validate-error [opt optarg msg]
(str "Failed to validate " (pr-join opt optarg)
(if msg (str ": " msg) "")))

(defn- validate [value spec opt optarg]
(let [{:keys [validate-fn validate-msg]} spec]
(if (or (nil? validate-fn)
(try (validate-fn value) (catch js/Error _)))
[value nil]
[::error (validate-error opt optarg validate-msg)])))

(defn- parse-value [value spec opt optarg]
(let [{:keys [parse-fn]} spec
[value error] (if parse-fn
(try
[(parse-fn value) nil]
(catch js/Error e
[nil (parse-error opt optarg (str e))]))
[value nil])]
(if error
[::error error]
(validate value spec opt optarg))))

(defn- parse-optarg [spec opt optarg]
(let [{:keys [required]} spec]
(if (and required (nil? optarg))
[::error (missing-required-error opt required)]
(parse-value (if required optarg true) spec opt optarg))))

(defn- parse-option-tokens
"Reduce sequence of [opt-type opt ?optarg?] tokens into a map of
{option-id value} merged over the default values in the option
specifications.
Unknown options, missing required arguments, option argument parsing
exceptions, and validation failures are collected into a vector of error
message strings.
Returns [option-map error-messages-vector]."
[specs tokens]
(reduce
(fn [[m errors] [opt-type opt optarg]]
(if-let [spec (find-spec specs opt-type opt)]
(let [[value error] (parse-optarg spec opt optarg)]
(if-not (= value ::error)
[((:assoc-fn spec assoc) m (:id spec) value) errors]
[m (conj errors error)]))
[m (conj errors (str "Unknown option: " (pr-str opt)))]))
[(default-option-map specs) []] tokens))
186 changes: 95 additions & 91 deletions src/test/clojure/clojure/tools/cli_test.clj
View file
Expand Up @@ -28,99 +28,103 @@
(is (= (tokenize-args #{} ["-a" "foo" "-b"] :in-order true)
[[[:short-opt "-a"]] ["foo" "-b"]]))))

; (deftest test-compile-option-specs
; (testing "does not set values for :default unless specified"
; (is (= (map #(contains? % :default) (compile-option-specs
; [["-f" "--foo"]
; ["-b" "--bar=ARG" :default 0]]))
; [false true])))
; (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"}]))))
(deftest test-compile-option-specs
(testing "does not set values for :default unless specified"
(is (= (map #(contains? % :default) (compile-option-specs
[["-f" "--foo"]
["-b" "--bar=ARG" :default 0]]))
[false true])))
(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? ^:clj AssertionError #_(:cljs js/Error)
(compile-option-specs [["-a" :id nil]])))
(is (thrown? ^:clj AssertionError #_(:cljs js/Error)
(compile-option-specs [["-a" "--alpha"] ["-b" :id :alpha]])))
(is (thrown? ^:clj AssertionError #_(:cljs js/Error)
(compile-option-specs [{:id :a :short-opt "-a"} {:id :b :short-opt "-a"}])))
(is (thrown? ^:clj AssertionError #_(:cljs js/Error)
(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"}]))))

; (defn has-error? [re coll]
; (seq (filter (partial re-seq re) coll)))
(defn has-error? [re coll]
(seq (filter (partial re-seq re) coll)))

; (deftest test-parse-option-tokens
; (testing "parses and validates option arguments"
; (let [specs (compile-option-specs
; [["-p" "--port NUMBER"
; :parse-fn #(Integer/parseInt %)
; :validate [#(< 0 % 0x10000) "Must be between 0 and 65536"]]
; ["-f" "--file PATH"
; :validate [#(not= \/ (first %)) "Must be a relative path"]]
; ["-q" "--quiet"
; :id :verbose
; :default true
; :parse-fn not]])]
; (is (= (parse-option-tokens specs [[:long-opt "--port" "80"] [:short-opt "-q"]])
; [{:port (int 80) :verbose false} []]))
; (is (has-error? #"Unknown option"
; (peek (parse-option-tokens specs [[:long-opt "--unrecognized"]]))))
; (is (has-error? #"Missing required"
; (peek (parse-option-tokens specs [[:long-opt "--port"]]))))
; (is (has-error? #"Must be between"
; (peek (parse-option-tokens specs [[:long-opt "--port" "0"]]))))
; (is (has-error? #"Error while parsing"
; (peek (parse-option-tokens specs [[:long-opt "--port" "FOO"]]))))
; (is (has-error? #"Must be a relative path"
; (peek (parse-option-tokens specs [[:long-opt "--file" "/foo"]]))))))
; (testing "merges values over default option map"
; (let [specs (compile-option-specs
; [["-a" "--alpha"]
; ["-b" "--beta" :default false]
; ["-g" "--gamma=ARG"]
; ["-d" "--delta=ARG" :default "DELTA"]])]
; (is (= (parse-option-tokens specs [])
; [{:beta false :delta "DELTA"} []]))
; (is (= (parse-option-tokens specs [[:short-opt "-a"]
; [:short-opt "-b"]
; [:short-opt "-g" "GAMMA"]
; [:short-opt "-d" "delta"]])
; [{:alpha true :beta true :gamma "GAMMA" :delta "delta"} []]))))
; (testing "associates :id and value with :assoc-fn"
; (let [specs (compile-option-specs
; [["-a" "--alpha"
; :default true
; :assoc-fn (fn [m k v] (assoc m k (not v)))]
; ["-v" "--verbose"
; :default 0
; :assoc-fn (fn [m k _] (assoc m k (inc (m k))))]])]
; (is (= (parse-option-tokens specs [])
; [{:alpha true :verbose 0} []]))
; (is (= (parse-option-tokens specs [[:short-opt "-a"]])
; [{:alpha false :verbose 0} []]))
; (is (= (parse-option-tokens specs [[:short-opt "-v"]
; [:short-opt "-v"]
; [:long-opt "--verbose"]])
; [{:alpha true :verbose 3} []])))))
(deftest test-parse-option-tokens
(testing "parses and validates option arguments"
(let [specs (compile-option-specs
[["-p" "--port NUMBER"
:parse-fn (fn [x]
^:clj (Integer/parseInt x)
#_(:cljs (do (assert (re-seq #"^\d" x)) (js/parseInt x))))
:validate [#(< 0 % 0x10000) "Must be between 0 and 65536"]]
["-f" "--file PATH"
:validate [#(not= \/ (first %)) "Must be a relative path"]]
["-q" "--quiet"
:id :verbose
:default true
:parse-fn not]])]
(is (= (parse-option-tokens specs [[:long-opt "--port" "80"] [:short-opt "-q"]])
[{:port (int 80) :verbose false} []]))
(is (has-error? #"Unknown option"
(peek (parse-option-tokens specs [[:long-opt "--unrecognized"]]))))
(is (has-error? #"Missing required"
(peek (parse-option-tokens specs [[:long-opt "--port"]]))))
(is (has-error? #"Must be between"
(peek (parse-option-tokens specs [[:long-opt "--port" "0"]]))))
(is (has-error? #"Error while parsing"
(peek (parse-option-tokens specs [[:long-opt "--port" "FOO"]]))))
(is (has-error? #"Must be a relative path"
(peek (parse-option-tokens specs [[:long-opt "--file" "/foo"]]))))))
(testing "merges values over default option map"
(let [specs (compile-option-specs
[["-a" "--alpha"]
["-b" "--beta" :default false]
["-g" "--gamma=ARG"]
["-d" "--delta=ARG" :default "DELTA"]])]
(is (= (parse-option-tokens specs [])
[{:beta false :delta "DELTA"} []]))
(is (= (parse-option-tokens specs [[:short-opt "-a"]
[:short-opt "-b"]
[:short-opt "-g" "GAMMA"]
[:short-opt "-d" "delta"]])
[{:alpha true :beta true :gamma "GAMMA" :delta "delta"} []]))))
(testing "associates :id and value with :assoc-fn"
(let [specs (compile-option-specs
[["-a" "--alpha"
:default true
:assoc-fn (fn [m k v] (assoc m k (not v)))]
["-v" "--verbose"
:default 0
:assoc-fn (fn [m k _] (assoc m k (inc (m k))))]])]
(is (= (parse-option-tokens specs [])
[{:alpha true :verbose 0} []]))
(is (= (parse-option-tokens specs [[:short-opt "-a"]])
[{:alpha false :verbose 0} []]))
(is (= (parse-option-tokens specs [[:short-opt "-v"]
[:short-opt "-v"]
[:long-opt "--verbose"]])
[{:alpha true :verbose 3} []])))))

; (deftest test-summarize
; (testing "summarizes options"
Expand Down

0 comments on commit 8e33c0a

Please sign in to comment.