diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 9cdc82d..925acc1 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -31,7 +31,8 @@ jobs: - name: Setup Clojure uses: DeLaGuardo/setup-clojure@13.5 with: - bb: latest + bb: 1.12.218 + github-token: ${{ secrets.GITHUB_TOKEN }} - name: Run tests run: | @@ -60,7 +61,8 @@ jobs: - name: Setup Clojure uses: DeLaGuardo/setup-clojure@13.5 with: - bb: latest + bb: 1.12.218 + github-token: ${{ secrets.GITHUB_TOKEN }} - name: Run tests run: | diff --git a/CHANGELOG.md b/CHANGELOG.md index 3340f02..72692e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,11 @@ For breaking changes, check [here](#breaking-changes). ([@lread](https://github.com/lread)) - [#144](https://github.com/babashka/cli/issues/144): deployed pom now reflects min supported clojure version & doc supported platforms/versions ([@lread](https://github.com/lread)) +- Expose `parse-opts*`: parses args to raw map, no coercion / defaults / validation +- Expose `coerce-opts`: standalone coerce step +- Expose `validate-opts`: standalone `:restrict` / `:require` / `:validate` step +- Add `apply-defaults`: fills missing keys from `:exec-args` or spec `:default` +- Coerce error data includes `:implicit-true true` when the failure was an implicit `--foo` with no value ## v0.8.67 (2025-11-21) diff --git a/src/babashka/cli.cljc b/src/babashka/cli.cljc index a6d2471..3005f53 100644 --- a/src/babashka/cli.cljc +++ b/src/babashka/cli.cljc @@ -113,8 +113,9 @@ (if (keyword? f) (name f) f)) - {:input s - :coerce-fn f} + (cond-> {:input s + :coerce-fn f} + implicit-true? (assoc :implicit-true true)) e))) (defn- coerce* @@ -148,38 +149,25 @@ [s f] (coerce* s f false)) -(defn- coerce->collect [k] - (when (coll? k) - (empty k))) +(defn- collect-fn + "Returns the collection function for opt, derived from collect-opts and coerce-map." + [collect-opts coerce-map opt] + (let [f (or (get collect-opts opt) + (let [k (get coerce-map opt)] + (when (coll? k) (empty k))))] + (when f + (if (coll? f) (fnil conj f) f)))) -(defn- coerce-collect-fn [collect-opts opt coercek] - (let [collect-fn (or (get collect-opts opt) - (coerce->collect coercek)) - collect-fn (when collect-fn - (if (coll? collect-fn) - (fnil conj collect-fn) - collect-fn))] - collect-fn)) - -(defn- process-previous [acc current-opt added collect-fn] +(defn- process-previous [acc current-opt added cf] (if (not= current-opt added) - (if-let [[_ curr-val] (find acc current-opt)] - (assoc acc current-opt (if collect-fn - (collect-fn curr-val true) - true)) - (assoc acc current-opt - (if collect-fn - (collect-fn nil true) - true))) + (let [v (if cf (cf (get acc current-opt) true) true)] + (assoc acc current-opt v)) acc)) -(defn- add-val [acc current-opt collect-fn coerce-fn arg implicit-true?] - (let [arg (if (and coerce-fn - (not (coll? coerce-fn))) (coerce* arg coerce-fn implicit-true?) - (auto-coerce arg))] - (if collect-fn - (update acc current-opt collect-fn arg) - (assoc acc current-opt arg)))) +(defn- add-val [acc current-opt cf arg] + (if cf + (update acc current-opt cf arg) + (assoc acc current-opt arg))) (defn spec->opts "Converts spec into opts format. Pass existing opts as optional second argument." @@ -234,7 +222,7 @@ {:args new-args :args->opts args->opts}))) -(defn- parse-key [arg mode current-opt coerce-opt added known-keys alias-keys] +(defn- parse-key [arg mode current-opt boolean-opt? added known-keys alias-keys] (let [fst-char (first-char arg) snd-char (second-char arg) hyphen-opt? (and (not= :keywords mode) @@ -249,7 +237,7 @@ fst-colon? (= \: fst-char) kwd-opt? (and (not= :hyphens mode) fst-colon? - (or (= :boolean coerce-opt) + (or boolean-opt? (not current-opt) (= added current-opt))) mode (or mode @@ -264,231 +252,131 @@ :kwd-opt kwd-opt? :fst-colon fst-colon?})) -(defn parse-opts - "Returns a map of options parsed from command line arguments `args`, a seq of strings. - Instead of a leading `:` either `--` or `-` may be used as well. - - Metadata on returned map, under `:org.babashka/cli`: - * `:args` remaining unparsed `args` (not corresponding to any options) - - Supported `opts`: - * `:coerce` - a map of option (keyword) names to type keywords (optionally wrapped in a collection.) - * `:alias` - a map of short names to long names. +(defn- ->error-fn [spec error-fn-opt] + (let [f (or error-fn-opt + (fn [data] + (throw (ex-info (:msg data) data))))] + (fn [data] + (f (merge {:spec spec :type :org.babashka/cli} data))))) + +(defn- resolve-opts [opts] + (if (::resolved opts) + opts + (let [spec (:spec opts)] + (assoc (if spec (merge-opts opts (spec->opts spec opts)) opts) + ::resolved true)))) + +(defn coerce-opts + "Coerces values in the map `m` using the provided configuration. + Does not coerce values that are not strings. + Returns a new map with coerced values. + + Supported options: + * `:coerce` - a map of option (keyword) names to type keywords (optionally wrapped in a collection). * `:spec` - a spec of options. See [spec](https://github.com/babashka/cli#spec). - * `:restrict` - `true` or coll of keys. Throw on first parsed option not in set of keys or keys of `:spec` and `:coerce` combined. - * `:require` - a coll of options that are required. See [require](https://github.com/babashka/cli#restrict). - * `:validate` - a map of validator functions. See [validate](https://github.com/babashka/cli#validate). - * `:exec-args` - a map of default args. Will be overridden by args specified in `args`. - * `:no-keyword-opts` - `true`. Support only `--foo`-style opts (i.e. `:foo` will not work). - * `:repeated-opts` - `true`. Forces writing the option name for every value, e.g. `--foo a --foo b`, rather than `--foo a b` - * `:args->opts` - consume unparsed commands and args as options - * `:collect` - a map of collection fns. See [custom collection handling](https://github.com/babashka/cli#custom-collection-handling). - - Examples: - - ```clojure - (parse-opts [\"foo\" \":bar\" \"1\"]) - ;; => ^{:org.babashka/cli {:args [\"foo\"]}} {:bar 1} - (parse-opts [\":b\" \"1\"] {:aliases {:b :bar} :coerce {:bar parse-long}}) - ;; => {:bar 1} - (parse-opts [\"--baz\" \"--qux\"] {:spec {:baz {:desc \"Baz\"}} :restrict true}) - ;; => throws 'Unknown option --qux' exception b/c there is no :qux key in the spec - ``` - See also: [[parse-args]]" - ([args] (parse-opts args {})) - ([args opts] + * `:error-fn` - error handler, called with a map containing `:cause` (`:coerce`), `:msg`, `:option`, `:value`, and `:opts`." + ([m] (coerce-opts m {})) + ([m opts] (let [spec (:spec opts) - opts (if spec - (merge-opts - opts - (spec->opts spec opts)) - opts) - coerce-opts (:coerce opts) - aliases (or - (:alias opts) - (:aliases opts)) - collect (:collect opts) - require (:require opts) - exec-args (:exec-args opts) - no-keyword-opts (:no-keyword-opts opts) - restrict (or (:restrict opts) - (:closed opts)) + opts (resolve-opts opts) + coerce-map (:coerce opts) + m-meta (meta m) + implicit-true-keys (or (::implicit-true-keys opts) + (::implicit-true-keys m-meta)) + auto-coerce? (::auto-coerce opts) + keys-order (or (::keys-order opts) + (::keys-order m-meta)) + error-fn (->error-fn spec (:error-fn opts))] + (if (or (seq coerce-map) auto-coerce?) + (let [coerce-1 (fn [v cf implicit-true?] + (if cf (coerce* v cf implicit-true?) (auto-coerce v))) + ordered-keys (if (seq keys-order) + (concat keys-order + (remove (set keys-order) (keys m))) + (keys m))] + (with-meta + (reduce + (fn [acc k] + (let [v (get m k)] + (if-let [coerce-k (get coerce-map k)] + (let [coll-coerce? (coll? coerce-k) + empty-coll (when coll-coerce? (or (empty coerce-k) [])) + cf (coerce-coerce-fn coerce-k) + it? (and implicit-true-keys (contains? implicit-true-keys k))] + (try + (cond + (and coll-coerce? (coll? v)) + (assoc acc k (reduce (fn [coll elem] (conj coll (coerce-1 elem cf it?))) empty-coll v)) + coll-coerce? + (assoc acc k (conj empty-coll (coerce-1 v cf it?))) + (coll? v) + (assoc acc k (into (empty v) (map #(coerce-1 % cf it?)) v)) + :else + (assoc acc k (coerce-1 v cf it?))) + (catch #?(:clj ExceptionInfo :cljs :default) e + (let [data (ex-data e)] + (error-fn (cond-> {:cause :coerce + :msg #?(:clj (.getMessage e) + :cljs (ex-message e)) + :option k + :value v + :opts acc} + (:implicit-true data) (assoc :implicit-true true)))) + acc))) + (if auto-coerce? + (assoc acc k (auto-coerce v)) + (assoc acc k v))))) + {} ordered-keys) + (meta m))) + m)))) + +(defn validate-opts + "Validates the map `m` using the provided configuration. Returns `m`. + + Supported options: + * `:restrict` - `true` or coll of keys. Error on keys in `m` not in the restrict set or not derivable from `:spec` and `:coerce`. + * `:require` - a coll of options that are required. + * `:validate` - a map of option keys to validator functions (or maps with `:pred` and `:ex-msg`). + * `:spec` - a spec of options (restrict, require, validate extracted from it). + * `:coerce` - used with `:restrict true` to derive the set of known keys. + * `:error-fn` - error handler, called with a map containing `:cause`, `:msg`, `:option`, and `:opts`." + ([m] (validate-opts m {})) + ([m opts] + (let [spec (:spec opts) + opts (resolve-opts opts) + coerce-map (:coerce opts) + aliases (or (:alias opts) + (:aliases opts)) spec-map (if (map? spec) - spec (into {} spec)) - alias-keys (set (concat (keys aliases) (map :alias (vals spec-map)))) + spec (when spec (into {} spec))) known-keys (set (concat (keys spec-map) (vals aliases) - (keys coerce-opts))) + (keys coerce-map))) + restrict (or (:restrict opts) + (:closed opts)) restrict (if (true? restrict) known-keys (some-> restrict set)) + require (:require opts) validate (:validate opts) - error-fn* (or (:error-fn opts) - (fn [{:keys [msg] :as data}] - (throw (ex-info msg data)))) - error-fn (fn [data] - (-> {:spec spec :type :org.babashka/cli} - (merge data) - error-fn*)) - {:keys [cmds args]} (parse-cmds args) - {new-args :args - a->o :args->opts} - (if-let [a->o (or (:args->opts opts) - ;; DEPRECATED: - (:cmds-opts opts))] - (args->opts cmds a->o (::dispatch-tree-ignored-args opts)) - {:args->opts nil - :args args}) - [cmds args] (if (not= new-args args) - [nil (concat new-args args)] - [cmds args]) - ;; _ (prn :cmds cmds :args args) - opts* opts - [opts last-opt added] - (if (and (::dispatch-tree opts) - (seq cmds)) - [(vary-meta {} assoc-in [:org.babashka/cli :args] (into (vec cmds) args)) nil nil] - (loop [acc {} - current-opt nil - added nil - mode (when no-keyword-opts :hyphens) - args (seq args) - a->o a->o] - ;; (prn :acc acc :current-opt current-opt :added added :args args) - (if-not args - [acc current-opt added] - (let [raw-arg (first args) - opt? (keyword? raw-arg)] - (if opt? - (recur (process-previous acc current-opt added nil) - raw-arg added mode (next args) - a->o) - (let [implicit-true? (true? raw-arg) - arg (str raw-arg) - collect-fn (coerce-collect-fn collect current-opt (get coerce-opts current-opt)) - coerce-opt (get coerce-opts current-opt) - {:keys [hyphen-opt - composite-opt - kwd-opt - mode fst-colon]} (parse-key arg mode current-opt coerce-opt added known-keys alias-keys)] - (if (or hyphen-opt - kwd-opt) - (let [long-opt? (str/starts-with? arg "--") - the-end? (and long-opt? (= "--" arg))] - (if the-end? - (let [nargs (next args)] - [(cond-> acc - nargs (vary-meta assoc-in [:org.babashka/cli :args] (vec nargs))) - current-opt added]) - (let [kname (if long-opt? - (subs arg 2) - (str/replace arg #"^(:|-|)" "")) - [kname arg-val] (if long-opt? - (str/split kname #"=") - [kname]) - raw-k (keyword kname) - alias (when-not long-opt? - (get aliases raw-k)) - k (or alias raw-k)] - (if arg-val - (recur (process-previous acc current-opt added collect-fn) - k nil mode (cons arg-val (rest args)) a->o) - (let [next-args (next args) - next-arg (first next-args) - m (parse-key next-arg mode current-opt coerce-opt added known-keys alias-keys) - negative? (when-not (contains? known-keys k) - (str/starts-with? (str k) ":no-"))] - (if (or (:hyphen-opt m) - (empty? next-args) - negative?) - ;; implicit true - (if (and (not alias) composite-opt) - (let [chars (name k) - args (mapcat (fn [char] - [(str "-" char) true]) - chars) - next-args (concat args next-args)] - (recur acc - nil nil mode next-args - a->o)) - (let [k (if negative? - (keyword (str/replace (str k) ":no-" "")) - k) - next-args (cons (not negative?) next-args)] - (recur (process-previous acc current-opt added collect-fn) - k added mode next-args - a->o))) - (recur (process-previous acc current-opt added collect-fn) - k nil mode next-args - a->o))))))) - (let [the-end? (or - (and (= :boolean coerce-opt) - (not= arg "true") - (not= arg "false")) - (and (= added current-opt) - (or - (not collect-fn) - (:repeated-opts opts) - (contains? (::dispatch-tree-ignored-args opts) (first args)))))] - (if the-end? - (let [{new-args :args - a->o :args->opts} - (if args - (if a->o - (args->opts args a->o (::dispatch-tree-ignored-args opts)) - {:args args}) - {:args args}) - new-args? (not= args new-args)] - (if new-args? - (recur acc current-opt added mode new-args a->o) - [(vary-meta acc assoc-in [:org.babashka/cli :args] (vec args)) current-opt added])) - (let [opt (when-not (and (= :keywords mode) - fst-colon) - current-opt)] - (recur (try - (add-val acc current-opt collect-fn (coerce-coerce-fn coerce-opt) arg implicit-true?) - (catch #?(:clj ExceptionInfo :cljs :default) e - (error-fn {:cause :coerce - :msg #?(:clj (.getMessage e) - :cljs (ex-message e)) - :option current-opt - :value arg - :opts acc}) - ;; Since we've encountered an error, don't add this opt - acc)) - opt - opt - mode - (next args) - a->o))))))))))) - collect-fn (coerce-collect-fn collect last-opt (get coerce-opts last-opt)) - opts (-> (process-previous opts last-opt added collect-fn) - (cond-> - (and (seq cmds) (not (::dispatch-tree opts*))) - (vary-meta update-in [:org.babashka/cli :args] - (fn [args] - (into (vec cmds) args))))) - opts (if exec-args - (with-meta (merge exec-args opts) - (meta opts)) - opts)] + error-fn (->error-fn spec (:error-fn opts))] (when restrict - (doseq [k (keys opts)] + (doseq [k (keys m)] (when (and (not (contains? restrict k)) - (not= (namespace k) "babashka.cli")) + (not= "babashka.cli" (namespace k))) (error-fn {:cause :restrict :msg (str "Unknown option: " k) :restrict restrict :option k - :opts opts})))) + :opts m})))) (when require (doseq [k require] - (when-not (find opts k) + (when-not (find m k) (error-fn {:cause :require :msg (str "Required option: " k) :require require :option k - :opts opts})))) + :opts m})))) (when validate (doseq [[k vf] validate] (let [f (or (and @@ -497,7 +385,7 @@ (map? vf) (:pred vf)) vf)] - (when-let [[_ v] (find opts k)] + (when-let [[_ v] (find m k)] (when-not (f v) (let [ex-msg-fn (or (:ex-msg vf) (fn [{:keys [option value]}] @@ -507,8 +395,210 @@ :validate validate :option k :value v - :opts opts}))))))) - opts))) + :opts m}))))))) + m))) + +(defn apply-defaults + "Fills missing keys in `m` from defaults. Existing keys in `m` win. + Preserves metadata of `m`. + + Supported options: + * `:exec-args` - map of defaults. + * `:spec` - spec; `:default` entries become defaults via `spec->opts`." + ([m] (apply-defaults m {})) + ([m opts] + (let [opts (resolve-opts opts) + exec-args (:exec-args opts)] + (if exec-args + (with-meta (merge exec-args m) (meta m)) + m)))) + +;; +;; Parsing +;; + +(defn parse-opts* + "Parses CLI `args` into a raw opts map. Returns string values unchanged + (no coercion), does not apply `:exec-args` defaults, does not run + `:restrict`/`:require`/`:validate`. Result map includes + `:org.babashka/cli` metadata and internal `::implicit-true-keys` / + `::keys-order` metadata used by `coerce-opts`. + + Use this when you want to merge other sources (e.g. config files) + before coerce/validate. Pipeline: `parse-opts*` -> merge -> `apply-defaults` + -> `coerce-opts` -> `validate-opts`. + + Supported options (subset of `parse-opts`): `:alias`/`:aliases`, `:coerce`, + `:collect`, `:no-keyword-opts`, `:repeated-opts`, `:args->opts`, `:spec`." + [args {:keys [coerce collect no-keyword-opts repeated-opts] :as opts}] + (let [aliases (or (:alias opts) (:aliases opts)) + spec (:spec opts) + spec-map (if (map? spec) spec (when spec (into {} spec))) + alias-keys (set (concat (keys aliases) (map :alias (vals spec-map)))) + known-keys (set (concat (keys spec-map) (vals aliases) (keys coerce))) + bool? (fn [k] (#{:boolean :bool} (coerce-coerce-fn (get coerce k)))) + track-itk (fn [itk current-opt added] + (cond-> itk (not= current-opt added) (conj current-opt))) + track-kpo (fn [kpo k] + (if (and k (not (some #{k} kpo))) + (conj kpo k) + kpo)) + {:keys [cmds args]} (parse-cmds args) + {new-args :args a->o :args->opts} + (if-let [a->o (or (:args->opts opts) (:cmds-opts opts))] + (args->opts cmds a->o (::dispatch-tree-ignored-args opts)) + {:args->opts nil :args args}) + [cmds args] (if (not= new-args args) + [nil (concat new-args args)] + [cmds args]) + [parsed last-opt added itk kpo] + (if (and (::dispatch-tree opts) (seq cmds)) + [(vary-meta {} assoc-in [:org.babashka/cli :args] (into (vec cmds) args)) nil nil #{} []] + (loop [acc {} + current-opt nil + added nil + mode (when no-keyword-opts :hyphens) + args (seq args) + a->o a->o + itk #{} + kpo []] + (if-not args + [acc current-opt added itk kpo] + (let [raw-arg (first args) + opt? (keyword? raw-arg)] + (if opt? + (recur (process-previous acc current-opt added nil) + raw-arg added mode (next args) a->o + (track-itk itk current-opt added) + (track-kpo kpo raw-arg)) + (let [implicit-true? (true? raw-arg) + arg (str raw-arg) + cf (collect-fn collect coerce current-opt) + boolean-opt? (bool? current-opt) + {:keys [hyphen-opt composite-opt kwd-opt mode fst-colon]} + (parse-key arg mode current-opt boolean-opt? added known-keys alias-keys)] + (if (or hyphen-opt kwd-opt) + (let [long-opt? (str/starts-with? arg "--") + the-end? (and long-opt? (= "--" arg))] + (if the-end? + (let [nargs (next args)] + [(cond-> acc + nargs (vary-meta assoc-in [:org.babashka/cli :args] (vec nargs))) + current-opt added itk kpo]) + (let [kname (if long-opt? + (subs arg 2) + (str/replace arg #"^(:|-|)" "")) + [kname arg-val] (if long-opt? + (str/split kname #"=") + [kname]) + raw-k (keyword kname) + alias (when-not long-opt? (get aliases raw-k)) + k (or alias raw-k)] + (if arg-val + (recur (process-previous acc current-opt added cf) + k nil mode (cons arg-val (rest args)) a->o + (track-itk itk current-opt added) + (track-kpo kpo k)) + (let [next-args (next args) + next-arg (first next-args) + m (parse-key next-arg mode current-opt boolean-opt? added known-keys alias-keys) + negative? (when-not (contains? known-keys k) + (str/starts-with? (str k) ":no-"))] + (if (or (:hyphen-opt m) (empty? next-args) negative?) + ;; implicit true + (if (and (not alias) composite-opt) + (let [expanded (mapcat (fn [c] [(str "-" c) true]) (name k))] + (recur acc nil nil mode (concat expanded next-args) a->o itk kpo)) + (let [k (if negative? + (keyword (str/replace (str k) ":no-" "")) + k)] + (recur (process-previous acc current-opt added cf) + k added mode (cons (not negative?) next-args) a->o + (track-itk itk current-opt added) + (track-kpo kpo k)))) + (recur (process-previous acc current-opt added cf) + k nil mode next-args a->o + (track-itk itk current-opt added) + (track-kpo kpo k)))))))) + (let [the-end? (or + (and boolean-opt? + (not= "true" arg) + (not= "false" arg)) + (and (= added current-opt) + (or (not cf) + repeated-opts + (contains? (::dispatch-tree-ignored-args opts) (first args)))))] + (if the-end? + (let [{new-args :args a->o :args->opts} + (if (and args a->o) + (args->opts args a->o (::dispatch-tree-ignored-args opts)) + {:args args}) + new-args? (not= args new-args)] + (if new-args? + (recur acc current-opt added mode new-args a->o itk kpo) + [(vary-meta acc assoc-in [:org.babashka/cli :args] (vec args)) current-opt added itk kpo])) + (let [opt (when-not (and (= :keywords mode) fst-colon) current-opt)] + (recur (add-val acc current-opt cf arg) + opt opt mode (next args) a->o + (cond-> itk implicit-true? (conj current-opt)) + kpo))))))))))) + ;; Finalize: process last opt, prepend cmds to args metadata + itk (track-itk itk last-opt added) + cf (collect-fn collect coerce last-opt) + parsed (-> (process-previous parsed last-opt added cf) + (cond-> + (and (seq cmds) (not (::dispatch-tree opts))) + (vary-meta update-in [:org.babashka/cli :args] + (fn [args] (into (vec cmds) args)))))] + (vary-meta parsed assoc ::implicit-true-keys itk ::keys-order kpo))) + +(defn parse-opts + "Returns a map of options parsed from command line arguments `args`, a seq of strings. + Instead of a leading `:` either `--` or `-` may be used as well. + + Metadata on returned map, under `:org.babashka/cli`: + * `:args` remaining unparsed `args` (not corresponding to any options) + + Supported `opts`: + * `:coerce` - a map of option (keyword) names to type keywords (optionally wrapped in a collection.) + * `:alias` - a map of short names to long names. + * `:spec` - a spec of options. See [spec](https://github.com/babashka/cli#spec). + * `:restrict` - `true` or coll of keys. Throw on first parsed option not in set of keys or keys of `:spec` and `:coerce` combined. + * `:require` - a coll of options that are required. See [require](https://github.com/babashka/cli#restrict). + * `:validate` - a map of validator functions. See [validate](https://github.com/babashka/cli#validate). + * `:exec-args` - a map of default args. Will be overridden by args specified in `args`. Values from `:exec-args` are NOT coerced or auto-coerced; provide them in their final form. + * `:no-keyword-opts` - `true`. Support only `--foo`-style opts (i.e. `:foo` will not work). + * `:repeated-opts` - `true`. Forces writing the option name for every value, e.g. `--foo a --foo b`, rather than `--foo a b` + * `:args->opts` - consume unparsed commands and args as options + * `:collect` - a map of collection fns. See [custom collection handling](https://github.com/babashka/cli#custom-collection-handling). + + Examples: + + ```clojure + (parse-opts [\"foo\" \":bar\" \"1\"]) + ;; => ^{:org.babashka/cli {:args [\"foo\"]}} {:bar 1} + (parse-opts [\":b\" \"1\"] {:aliases {:b :bar} :coerce {:bar parse-long}}) + ;; => {:bar 1} + (parse-opts [\"--baz\" \"--qux\"] {:spec {:baz {:desc \"Baz\"}} :restrict true}) + ;; => throws 'Unknown option --qux' exception b/c there is no :qux key in the spec + ``` + See also: [[parse-args]]" + ([args] (parse-opts args {})) + ([args opts] + (let [opts (resolve-opts opts) + ;; Step 1: Parse (raw strings, no coercion) + parsed (parse-opts* args opts) + ;; Step 2: Coerce + coerced (coerce-opts parsed {:coerce (:coerce opts) + :spec (:spec opts) + :error-fn (:error-fn opts) + ::auto-coerce true + ::resolved true}) + ;; Step 3: Apply defaults + coerced (apply-defaults coerced opts) + ;; Step 4: Validate + validated (validate-opts coerced opts)] + (vary-meta validated dissoc ::implicit-true-keys ::keys-order)))) (defn parse-args "Same as [[parse-opts]] with return data reshaped. @@ -660,14 +750,10 @@ (dispatch-tree' tree args nil)) ([tree args opts] (loop [cmds [] all-opts {} args args cmd-info tree] - (let [;; cmd-info (:cmd cmd-info) - kwm cmd-info #_(select-keys cmd-info (filter keyword? (keys cmd-info))) + (let [kwm cmd-info should-parse-args? (or (has-parse-opts? kwm) (is-option? (first args))) - ;; _ (prn :opts opts :kwm kwm) parse-opts (deep-merge opts kwm) - ;; _ ((requiring-resolve 'clojure.pprint/pprint) parse-opts) - ;; _ (prn :dispatch-args args) {:keys [args opts]} (if should-parse-args? (parse-args args (assoc (update parse-opts :exec-args merge all-opts) ::dispatch-tree true @@ -678,15 +764,12 @@ all-opts (-> (merge all-opts opts) (update ::opts-by-cmds (fnil conj []) {:cmds cmds :opts opts}))] - ;; (prn :arg arg :all-opts all-opts) (if-let [subcmd-info (get (:cmd cmd-info) arg)] (recur (conj cmds arg) all-opts rest subcmd-info) (if (:fn cmd-info) {:cmd-info cmd-info :dispatch cmds :opts (dissoc all-opts ::opts-by-cmds) - ;; NOTE: won't expose this just yet, wait for more feedback, structure may not be optimal - ;; :opts-by-cmds (::opts-by-cmds all-opts) :args args} (if arg {:error :no-match diff --git a/test/babashka/cli_test.cljc b/test/babashka/cli_test.cljc index 9cca8d3..54d3cec 100644 --- a/test/babashka/cli_test.cljc +++ b/test/babashka/cli_test.cljc @@ -2,9 +2,9 @@ (:require [babashka.cli :as cli] [babashka.cli.test-report] + [borkdude.deflet :as d] [clojure.string :as str] [clojure.test :refer [deftest is testing]] - [borkdude.deflet :as d] #?(:clj [clojure.edn :as edn] :cljs [cljs.reader :as edn]))) @@ -468,7 +468,7 @@ (testing "auto-coerce multiple keywords in keywords mode" (is (submap? {:foo [:bar :baz]} (cli/parse-opts [":foo" ":bar" ":foo" ":baz"] {:coerce {:foo []}})))) (is (= 1 (cli/auto-coerce 1))) - (testing (str "We want to catch most normal keywords, staying close to the Clojure reader.") + (testing "We want to catch most normal keywords, staying close to the Clojure reader." (is (= "1. This is a title." (cli/auto-coerce "1. This is a title."))) (is (= ":1. This is a title." (cli/auto-coerce ":1. This is a title."))) (is (= :abc (cli/auto-coerce ":abc"))) @@ -477,7 +477,7 @@ (is (= (keyword "a/b/c") (cli/auto-coerce ":a/b/c"))) (is (= ":a.b c.d" (cli/auto-coerce ":a.b c.d"))) (is (= ":a.b\tc.d" (cli/auto-coerce ":a.b\tc.d")))) - (is (= nil (cli/auto-coerce "nil"))) + (is (nil? (cli/auto-coerce "nil"))) (is (= -10 (cli/auto-coerce "-10"))) (is (submap? {:foo -10} (cli/parse-opts ["--foo" "-10"]))) (is (submap? {:foo -10} (cli/parse-opts ["--foo" "-10"] {:coerce {:foo :number}}))) @@ -659,3 +659,174 @@ (deftest issue-126-test (is (= {:file "-"} (cli/parse-opts ["--file" "-"]))) (is (= {:file "-"} (cli/parse-opts ["-"] {:args->opts [:file]})))) + +(deftest coerce-opts-test + (testing "simple coercion" + (is (= {:foo 1 :bar "hello"} + (cli/coerce-opts {:foo "1" :bar "hello"} {:coerce {:foo :long}})))) + (testing "multiple coercions" + (is (= {:foo 1 :bar :baz} + (cli/coerce-opts {:foo "1" :bar "baz"} {:coerce {:foo :long :bar :keyword}})))) + (testing "non-string values pass through" + (is (= {:foo 1} (cli/coerce-opts {:foo 1} {:coerce {:foo :long}})))) + (testing "collection coerce on sequential value" + (is (= {:foo [1 2 3]} + (cli/coerce-opts {:foo ["1" "2" "3"]} {:coerce {:foo [:long]}})))) + (testing "collection coerce on single value" + (is (= {:foo [1]} + (cli/coerce-opts {:foo "1"} {:coerce {:foo [:long]}})))) + (testing "collection coerce with set" + (is (= {:foo #{1 2 3}} + (cli/coerce-opts {:foo ["1" "2" "3"]} {:coerce {:foo #{:long}}})))) + (testing "non-string collection elements pass through" + (is (= {:foo [1 2 3]} + (cli/coerce-opts {:foo [1 2 3]} {:coerce {:foo [:long]}})))) + (testing "auto-coerce without coerce fn" + (is (= {:foo [1 :bar true]} + (cli/coerce-opts {:foo ["1" ":bar" "true"]} {:coerce {:foo []}})))) + (testing "using spec" + (is (= {:foo :bar} + (cli/coerce-opts {:foo "bar"} {:spec {:foo {:coerce :keyword}}})))) + (testing "error-fn on coercion failure" + (let [errors (atom [])] + (cli/coerce-opts {:foo "not-a-number"} {:coerce {:foo :long} + :error-fn (fn [e] (swap! errors conj e))}) + (is (= :coerce (:cause (first @errors)))))) + (testing "error data includes :implicit-true for implicit-true coerce failures" + ;; `--foo` with no value parses to (implicit) `true`. If `:foo` has a + ;; coerce that rejects boolean true (e.g. `:string`), error data + ;; should expose `:implicit-true true` so downstream error mappers + ;; can distinguish "user typed --foo alone" from a real coerce failure. + (let [errors (atom [])] + (cli/parse-opts ["--foo"] {:coerce {:foo :string} + :error-fn (fn [e] (swap! errors conj e))}) + (is (= true (:implicit-true (first @errors)))) + (is (= :coerce (:cause (first @errors)))))) + (testing "error data does NOT include :implicit-true for explicit value failures" + (let [errors (atom [])] + (cli/parse-opts ["--foo" "abc"] {:coerce {:foo :long} + :error-fn (fn [e] (swap! errors conj e))}) + (is (nil? (:implicit-true (first @errors)))) + (is (= :coerce (:cause (first @errors)))))) + (testing "keys without coerce spec pass through unchanged" + (is (= {:foo "1" :bar "hello"} + (cli/coerce-opts {:foo "1" :bar "hello"} {:coerce {}}))))) + +(deftest validate-opts-test + (testing "restrict" + (is (thrown-with-msg? + Exception #"Unknown option: :bar" + (cli/validate-opts {:foo 1 :bar 2} {:restrict #{:foo}})))) + (testing "restrict with true and spec" + (is (thrown-with-msg? + Exception #"Unknown option: :bar" + (cli/validate-opts {:foo 1 :bar 2} {:spec {:foo {:coerce :long}} :restrict true})))) + (testing "restrict passes for known keys" + (is (= {:foo 1} + (cli/validate-opts {:foo 1} {:restrict #{:foo}})))) + (testing "require" + (is (thrown-with-msg? + Exception #"Required option: :bar" + (cli/validate-opts {:foo 1} {:require [:bar]})))) + (testing "require passes when present" + (is (= {:foo 1 :bar 2} + (cli/validate-opts {:foo 1 :bar 2} {:require [:bar]})))) + (testing "validate" + (is (thrown-with-msg? + Exception #"Invalid value for option :foo" + (cli/validate-opts {:foo 0} {:validate {:foo pos?}})))) + (testing "validate passes" + (is (= {:foo 1} + (cli/validate-opts {:foo 1} {:validate {:foo pos?}})))) + (testing "validate with pred and ex-msg" + (is (thrown-with-msg? + Exception #"Expected positive" + (cli/validate-opts {:foo 0} {:validate {:foo {:pred pos? + :ex-msg (fn [{:keys [option value]}] + (str "Expected positive for " option ": " value))}}})))) + (testing "using spec" + (is (thrown-with-msg? + Exception #"Required option: :foo" + (cli/validate-opts {} {:spec {:foo {:require true}}})))) + (testing "error-fn" + (let [errors (atom [])] + (cli/validate-opts {:foo 0} + {:require [:bar] + :validate {:foo pos?} + :error-fn (fn [e] (swap! errors conj e))}) + (is (= 2 (count @errors))) + (is (= :require (:cause (first @errors)))) + (is (= :validate (:cause (second @errors)))))) + (testing "returns the input map" + (is (= {:foo 1} (cli/validate-opts {:foo 1} {})))) + (testing "composing coerce-opts and validate-opts" + (is (= {:foo 1} + (-> {:foo "1"} + (cli/coerce-opts {:coerce {:foo :long}}) + (cli/validate-opts {:validate {:foo pos?}})))))) + +(deftest internal-meta-not-leaked-test + (testing "::implicit-true-keys not in parse-opts result meta" + (is (nil? (:babashka.cli/implicit-true-keys (meta (cli/parse-opts ["--foo"])))))) + (testing "::keys-order not in parse-opts result meta" + (is (nil? (:babashka.cli/keys-order (meta (cli/parse-opts ["--foo" "--bar" "1"]))))))) + +(deftest coerce-error-order-test + (testing "coerce errors fire in parse order, not hash order, for >8 keys" + (let [keys-list (mapv #(keyword (str "k" %)) (range 12)) + args (vec (mapcat (fn [k] [(str "--" (name k)) "notanumber"]) keys-list)) + coerce-spec (into {} (map (fn [k] [k :long]) keys-list)) + errs (atom [])] + (cli/parse-opts args {:coerce coerce-spec + :error-fn (fn [e] (swap! errs conj (:option e)))}) + (is (= keys-list @errs))))) + +(deftest parse-opts-star-test + (testing "parse-opts* returns raw strings (no coercion)" + (is (= {:foo "1"} (cli/parse-opts* ["--foo" "1"] {})))) + (testing "parse-opts* exposes ::implicit-true-keys + ::keys-order in meta" + (let [r (cli/parse-opts* ["--foo" "--bar" "1"] {})] + (is (= #{:foo} (:babashka.cli/implicit-true-keys (meta r)))) + (is (= [:foo :bar] (:babashka.cli/keys-order (meta r)))))) + (testing "parse-opts* skips :restrict / :require / :validate" + (is (= {:bar "1"} (cli/parse-opts* ["--bar" "1"] + {:restrict #{:foo} :require [:foo]}))))) + +(deftest apply-defaults-test + (testing "spec :default fills missing keys" + (is (= {:foo 1 :bar 2} + (cli/apply-defaults {:bar 2} {:spec {:foo {:default 1}}})))) + (testing "existing keys win over defaults" + (is (= {:foo 9} + (cli/apply-defaults {:foo 9} {:spec {:foo {:default 1}}})))) + (testing ":exec-args directly" + (is (= {:foo 1 :bar 2} + (cli/apply-defaults {:bar 2} {:exec-args {:foo 1}})))) + (testing "preserves meta" + (let [m (with-meta {:bar 2} {:keep :this})] + (is (= {:keep :this} (meta (cli/apply-defaults m {:exec-args {:foo 1}}))))))) + +(deftest squint-style-pipeline-test + (testing "parse* -> external merge -> apply-defaults -> coerce -> validate" + (let [spec {:paths {:coerce [:string] :default ["." "src"]} + :output-dir {:coerce :string :default "."} + :verbose {:coerce :boolean}} + ext-config {:output-dir "/tmp/custom"} + parsed (cli/parse-opts* ["--paths" "lib" "--verbose"] {:spec spec}) + ;; cli wins over external config + merged (with-meta (merge ext-config parsed) (meta parsed)) + with-defaults (cli/apply-defaults merged {:spec spec}) + coerced (cli/coerce-opts with-defaults {:spec spec + :babashka.cli/auto-coerce true}) + validated (cli/validate-opts coerced {:spec spec :restrict true})] + (is (= {:paths ["lib"] :output-dir "/tmp/custom" :verbose true} validated))))) + +(deftest bool-coerce-parse-key-pinning-test + (testing "coll-wrapped :boolean: implicit-true wrapped in coll" + (is (= {:foo [true]} (cli/parse-opts ["--foo"] {:coerce {:foo [:boolean]}})))) + (testing "coll-wrapped :boolean: explicit value coerced and wrapped" + (is (= {:foo [true]} (cli/parse-opts ["--foo" "true"] {:coerce {:foo [:boolean]}})))) + (testing ":bool keyword treated like :boolean" + (is (= {:foo true} (cli/parse-opts ["--foo"] {:coerce {:foo :bool}})))) + (testing ":bool with explicit false" + (is (= {:foo false} (cli/parse-opts ["--foo" "false"] {:coerce {:foo :bool}})))))