diff --git a/.clj-kondo/borkdude/deflet/borkdude/deflet.clj_kondo b/.clj-kondo/borkdude/deflet/borkdude/deflet.clj_kondo
new file mode 100644
index 0000000..caff7e9
--- /dev/null
+++ b/.clj-kondo/borkdude/deflet/borkdude/deflet.clj_kondo
@@ -0,0 +1,26 @@
+(ns borkdude.deflet
+ (:require [clj-kondo.hooks-api :as hooks-api]))
+
+(defn deflet* [children]
+ (let [f (first children)
+ r (next children)]
+ (if (and (hooks-api/list-node? f)
+ (#{'def 'defp} (hooks-api/sexpr (first (:children f)))))
+ (let [def-children (:children f)]
+ (with-meta (hooks-api/list-node
+ [(hooks-api/coerce 'clojure.core/let)
+ (hooks-api/vector-node [(second def-children)
+ (nth def-children 2)])
+ (deflet* r)])
+ (meta f)))
+ (if-not r (or f (hooks-api/coerce nil))
+ (with-meta
+ (hooks-api/list-node (list (hooks-api/coerce 'do)
+ f
+ (deflet* r)))
+ (meta f))))))
+
+(defn deflet [{:keys [node]}]
+ (let [children (:children node)
+ new-node (deflet* children)]
+ {:node new-node}))
diff --git a/.clj-kondo/borkdude/deflet/config.edn b/.clj-kondo/borkdude/deflet/config.edn
new file mode 100644
index 0000000..2bd4b3e
--- /dev/null
+++ b/.clj-kondo/borkdude/deflet/config.edn
@@ -0,0 +1,3 @@
+{:lint-as {borkdude.deflet/defp clojure.core/def}
+ :hooks {:analyze-call {borkdude.deflet/deflet borkdude.deflet/deflet
+ borkdude.deflet/defletp borkdude.deflet/deflet}}}
diff --git a/.dir-locals.el b/.dir-locals.el
index e6ec9ad..1787d04 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -1,2 +1,2 @@
((clojure-mode
- (cider-clojure-cli-aliases . ":repl")))
+ (cider-clojure-cli-aliases . ":repl:test")))
diff --git a/.gitignore b/.gitignore
index c2732e9..e7c1e92 100644
--- a/.gitignore
+++ b/.gitignore
@@ -9,3 +9,4 @@ target
.clj-kondo/rewrite-clj
.clj-kondo/funcool
cljs-test-runner-out
+src/scratch.clj
diff --git a/API.md b/API.md
index 833719b..a11da0c 100644
--- a/API.md
+++ b/API.md
@@ -60,9 +60,8 @@ Coerce string `s` using `f`. Does not coerce when `s` is not a string.
Subcommand dispatcher.
- Dispatches on first matching command entry in `table`. A match is
- determines by whether `:cmds`, a vector of strings, is a subsequence
- (matching from the start) of the invoked commands.
+ Dispatches on longest matching command entry in `table` by matching
+ subcommands to the `:cmds` vector and invoking the correspondig `:fn`.
Table is in the form:
@@ -79,12 +78,14 @@ Subcommand dispatcher.
* `:args` - concatenation of unparsed commands and args
* `:rest-cmds`: DEPRECATED, this will be removed in a future version
- This function does not throw. Use an empty `:cmds` vector to always match.
+ Use an empty `:cmds` vector to always match or to provide global options.
+
+ Provide an `:error-fn` to deal with non-matches.
Each entry in the table may have additional [`parse-args`](#parse-args) options.
- Examples: see [README.md](README.md#subcommands).
-
[source](https://github.com/babashka/cli/blob/main/src/babashka/cli.cljc#L567-L611)
+ For more information and examples, see [README.md](README.md#subcommands).
+
[source](https://github.com/babashka/cli/blob/main/src/babashka/cli.cljc#L650-L682)
## `format-opts`
``` clojure
diff --git a/README.md b/README.md
index ac12c32..07470e6 100644
--- a/README.md
+++ b/README.md
@@ -488,6 +488,52 @@ Additional `parse-arg` options may be passed in each table entry:
{:cmds [] :fn help}])
```
+Since cli 0.8.54 the order of `:cmds` in the table doesn't matter.
+
+### Shared options
+
+Since cli 0.8.54, babashka.cli supports parsing shared options in between and before the subcommands.
+
+E.g.:
+
+``` clojure
+(def global-spec {:foo {:coerce :keyword}})
+(def sub1-spec {:bar {:coerce :keyword}})
+(def sub2-spec {:baz {:coerce :keyword}})
+
+(def table
+ [{:cmds [] :spec global-spec}
+ {:cmds ["sub1"] :fn identity :spec sub1-spec}
+ {:cmds ["sub1" "sub2"] :fn identity :spec sub2-spec}])
+
+(cli/dispatch table ["--foo" "a" "sub1" "--bar" "b" "sub2" "--baz" "c" "arg"])
+
+;;=>
+
+{:dispatch ["sub1" "sub2"],
+ :opts {:foo :a, :bar :b, :baz :c},
+ :args ["arg"]}
+```
+
+Note that specs are not merged, such that:
+
+``` clojure
+(cli/dispatch table ["sub1" "--foo" "bar"])
+```
+
+returns `{:dispatch ["sub1"], :opts {:foo "bar"}}` (`"bar"` is not coerced as a keyword).
+
+Note that it is possible to use `:args->opts` but subcommands are always prioritized over arguments:
+
+``` clojure
+(def table
+ [{:cmds ["sub1"] :fn identity :spec sub1-spec :args->opts [:some-opt]}
+ {:cmds ["sub1" "sub2"] :fn identity :spec sub2-spec}])
+
+(cli/dispatch table ["sub1" "dude"]) ;;=> {:dispatch ["sub1"], :opts {:some-opt "dude"}}
+(cli/dispatch table ["sub1" "sub2"]) ;;=> {:dispatch ["sub1" "sub2"], :opts {}}
+```
+
## Babashka tasks
For documentation on babashka tasks, go
diff --git a/bb.edn b/bb.edn
index e249f90..802be8f 100644
--- a/bb.edn
+++ b/bb.edn
@@ -19,7 +19,7 @@
:task (apply clojure "-M:test" *command-line-args*)}
cljs-test {:doc "Run CLJS tests"
- :task (apply clojure "-M:cljs-test" *command-line-args*)}
+ :task (apply clojure "-M:test:cljs-test" *command-line-args*)}
quickdoc {:doc "Invoke quickdoc"
:requires ([quickdoc.api :as api])
diff --git a/deps.edn b/deps.edn
index 72bce9e..9ced22e 100644
--- a/deps.edn
+++ b/deps.edn
@@ -7,7 +7,8 @@
{:extra-paths ["test"]
:extra-deps {io.github.cognitect-labs/test-runner
{:git/tag "v0.5.1" :git/sha "dfb30dd"}
- babashka/fs {:mvn/version "0.1.11"}}
+ babashka/fs {:mvn/version "0.1.11"}
+ io.github.borkdude/deflet {:mvn/version "0.1.0"}}
:exec-args {:cmd "bb test"}
:main-opts ["-m" "babashka.cli.exec"]
:exec-fn babashka.test-runner/test #_cognitect.test-runner.api/test}
diff --git a/src/babashka/cli.cljc b/src/babashka/cli.cljc
index 3493364..3d4c2ac 100644
--- a/src/babashka/cli.cljc
+++ b/src/babashka/cli.cljc
@@ -215,20 +215,22 @@
:args args})))
(defn- args->opts
- [args args->opts]
- (let [[new-args args->opts]
- (if args->opts
- (if (seq args)
- (let [arg-count (count args)
- cnt (min arg-count
- (bounded-count arg-count args->opts))]
- [(concat (interleave args->opts args)
- (drop cnt args))
- (drop cnt args->opts)])
- [args args->opts])
- [args args->opts])]
- {:args new-args
- :args->opts args->opts}))
+ ([args args->opts-map] (args->opts args args->opts-map #{}))
+ ([args args->opts-map ignored-args]
+ (let [[new-args args->opts]
+ (if args->opts-map
+ (if (and (seq args)
+ (not (contains? ignored-args (first args))))
+ (let [arg-count (count args)
+ cnt (min arg-count
+ (bounded-count arg-count args->opts-map))]
+ [(concat (interleave args->opts-map args)
+ (drop cnt args))
+ (drop cnt args->opts-map)])
+ [args args->opts-map])
+ [args args->opts-map])]
+ {:args new-args
+ :args->opts args->opts})))
(defn- parse-key [arg mode current-opt coerce-opt added]
(let [fst-char (first-char arg)
@@ -324,122 +326,130 @@
(if-let [a->o (or (:args->opts opts)
;; DEPRECATED:
(:cmds-opts opts))]
- (args->opts cmds a->o)
+ (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]
- (loop [acc {}
- current-opt nil
- added nil
- mode (when no-keyword-opts :hyphens)
- args (seq args)
- a->o a->o]
- (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)]
- (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)
- k (get aliases raw-k 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)]
- (if (or (:hyphen-opt m)
- (empty? next-args))
- ;; implicit true
- (if 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 [negative? (when-not (contains? known-keys k)
- (str/starts-with? (str k) ":no-"))
- k (if negative?
- (keyword (str/replace (str k) ":no-" ""))
- k)
- next-args (cons (not negative?) #_"true" 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 added mode next-args
- a->o)))))))
- (let [the-end? (or
- (and (= :boolean coerce-opt)
- (not= arg "true")
- (not= arg "false"))
- (and (= added current-opt)
- (not collect-fn)))]
- (if the-end?
- (let [{new-args :args
- a->o :args->opts}
- (if args
- (if a->o
- (args->opts args a->o)
+ (if (and (::dispatch-tree opts)
+ (seq cmds))
+ (do
+ ;; (prn :result-to-dispatch cmds args :> (into (vec cmds) args))
+ [(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)]
+ (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)
+ k (get aliases raw-k 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)]
+ (if (or (:hyphen-opt m)
+ (empty? next-args))
+ ;; implicit true
+ (if 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 [negative? (when-not (contains? known-keys k)
+ (str/starts-with? (str k) ":no-"))
+ k (if negative?
+ (keyword (str/replace (str k) ":no-" ""))
+ k)
+ next-args (cons (not negative?) #_"true" 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 added mode next-args
+ a->o)))))))
+ (let [the-end? (or
+ (and (= :boolean coerce-opt)
+ (not= arg "true")
+ (not= arg "false"))
+ (and (= added current-opt)
+ (not collect-fn)))]
+ (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})
- {: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})
- ;; Since we've encountered an error, don't add this opt
- acc))
- opt
- opt
- mode
- (next args)
- a->o))))))))))
+ 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})
+ ;; 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->
- (seq cmds)
+ (and (seq cmds) (not (::dispatch-tree opts*)))
(vary-meta update-in [:org.babashka/cli :args]
(fn [args]
(into (vec cmds) args)))))
@@ -564,12 +574,100 @@
(when (= prefix a)
suffix)))
+(defn- table->tree [table]
+ (reduce (fn [tree {:as cfg :keys [cmds]}]
+ (let [ks (interleave (repeat :cmd) cmds)]
+ (if (seq ks)
+ (update-in tree ks merge (dissoc cfg :cmds))
+ ;; catch-all
+ (merge tree (dissoc cfg :cmds)))))
+ {} table))
+
+(comment
+ (table->tree [{:cmds [] :fn identity}])
+ )
+
+(defn- deep-merge [a b]
+ (reduce (fn [acc k] (update acc k (fn [v]
+ (if (map? v)
+ (deep-merge v (b k))
+ (b k)))))
+ a (keys b)))
+
+(defn- has-parse-opts? [m]
+ (some #{:spec :coerce :require :restrict :validate :args->opts :exec-args} (keys m)))
+
+(defn- is-option? [s]
+ (and s
+ (or (str/starts-with? s "-")
+ (str/starts-with? s ":"))))
+
+(defn- dispatch-tree'
+ ([tree args]
+ (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)))
+ 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
+ ::dispatch-tree-ignored-args (set (keys (:cmd cmd-info)))))
+ {:args args
+ :opts {}})
+ ;; _ (prn :dispatch-args-post args)
+ [arg & rest] args
+ 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
+ :wrong-input arg
+ :available-commands (keys (:cmd cmd-info))}
+ {:error :input-exhausted
+ :available-commands (keys (:cmd cmd-info))})))))))
+
+(defn- dispatch-tree
+ ([tree args]
+ (dispatch-tree tree args nil))
+ ([tree args opts]
+ (let [{:as res :keys [cmd-info error wrong-input available-commands]}
+ (dispatch-tree' tree args opts)
+ error-fn* (or (:error-fn opts)
+ (fn [{:keys [msg] :as data}]
+ (throw (ex-info msg data))))
+ error-fn (fn [data]
+ (-> {;; :tree tree
+ :type :org.babashka/cli
+ :wrong-input wrong-input :all-commands available-commands}
+ (merge data)
+ error-fn*))]
+ (case error
+ (:no-match :input-exhausted)
+ (error-fn {:cause error})
+ nil ((:fn cmd-info) (dissoc res :cmd-info))))))
+
(defn dispatch
"Subcommand dispatcher.
- Dispatches on first matching command entry in `table`. A match is
- determines by whether `:cmds`, a vector of strings, is a subsequence
- (matching from the start) of the invoked commands.
+ Dispatches on longest matching command entry in `table` by matching
+ subcommands to the `:cmds` vector and invoking the correspondig `:fn`.
Table is in the form:
@@ -586,26 +684,15 @@
* `:args` - concatenation of unparsed commands and args
* `:rest-cmds`: DEPRECATED, this will be removed in a future version
- This function does not throw. Use an empty `:cmds` vector to always match.
+ Use an empty `:cmds` vector to always match or to provide global options.
+
+ Provide an `:error-fn` to deal with non-matches.
Each entry in the table may have additional `parse-args` options.
- Examples: see [README.md](README.md#subcommands)."
- ([table args] (dispatch table args nil))
+ For more information and examples, see [README.md](README.md#subcommands)."
+ ([table args]
+ (dispatch table args {}))
([table args opts]
- (let [{:keys [cmds args] :as m} (parse-cmds args opts)]
- (reduce (fn [_ {dispatch :cmds
- f :fn
- :as sub-opts}]
- (when-let [suffix (split dispatch cmds)]
- (let [rest-cmds (some-> suffix seq vec)
- args (concat rest-cmds args)
- {:keys [opts args cmds]} (parse-args args (merge-opts opts sub-opts))
- args (concat cmds args)]
- (reduced (f (assoc m
- :args args
- ;; deprecated name: will be removed in the future!
- :rest-cmds args
- :opts opts
- :dispatch dispatch))))))
- nil table))))
+ (let [tree (-> table table->tree)]
+ (dispatch-tree tree args opts))))
diff --git a/test/babashka/cli_test.cljc b/test/babashka/cli_test.cljc
index fc6f298..54957f8 100644
--- a/test/babashka/cli_test.cljc
+++ b/test/babashka/cli_test.cljc
@@ -3,6 +3,7 @@
[babashka.cli :as cli]
[clojure.string :as str]
[clojure.test :refer [deftest is testing]]
+ [borkdude.deflet :as d]
#?(:clj [clojure.edn :as edn]
:cljs [cljs.reader :as edn])))
@@ -281,7 +282,139 @@
{:dispatch ["dep" "search"]
:opts {:search-term "cheshire"
:precision 100}}
- (cli/dispatch table ["dep" "search" "cheshire" "100"])))))
+ (cli/dispatch table ["dep" "search" "cheshire" "100"]))))
+
+ (testing "options of super commands"
+ (d/deflet
+ (def table [{:cmds ["foo" "bar"]
+ :spec {:baz {:coerce :boolean}}
+ :fn identity}
+ {:cmds ["foo" "bar" "baz"]
+ :spec {:quux {:coerce :keyword}}
+ :fn identity}])
+ (is (submap? {:type :org.babashka/cli
+ :cause :input-exhausted
+ :all-commands ["foo"]}
+ (try (cli/dispatch table [])
+ (catch Exception e (ex-data e)))))
+ (is (submap? {:dispatch ["foo" "bar"], :opts {:baz true}, :args ["quux"]}
+ (cli/dispatch table ["foo" "bar" "--baz" "quux"])))
+ (is (submap? {:dispatch ["foo" "bar" "baz"] , :opts {:baz true :quux :xyzzy}, :args nil}
+ (cli/dispatch table ["foo" "bar" "--baz" "baz" "--quux" "xyzzy"])))))
+
+ (testing "with global opts and conflicting options names"
+ (d/deflet
+ (def table [{:cmds [] :spec {:global {:coerce :boolean}}}
+ {:cmds ["foo"] :spec {:bar {:coerce :keyword}}}
+ {:cmds ["foo" "bar"]
+ :spec {:bar {:coerce :keyword}}
+ :fn identity}])
+ (is (submap?
+ {:dispatch ["foo" "bar"]
+ :opts {:bar :bar
+ :global true}
+ :args ["arg1"]}
+ (cli/dispatch table ["--global" "foo" "--bar" "bar" "bar" "arg1"])))))
+
+ (testing "distinguish options at every level"
+ (d/deflet
+ (def spec {:foo {:coerce :keyword}})
+ (def table [{:spec spec}
+ {:cmds ["foo"]
+ :spec spec
+ :fn identity}
+ {:cmds ["foo" "bar"]
+ :fn identity
+ :spec spec}
+ {:cmds ["foo" "bar" "baz"]
+ :spec spec
+ :fn identity}])
+ (is (submap?
+ {:dispatch ["foo" "bar"],
+ :opts {:foo :dude3},
+ #_#_:opts-by-cmds
+ [{:cmds [], :opts {:foo :dude1}}
+ {:cmds ["foo"], :opts {:foo :dude2}}
+ {:cmds ["foo" "bar"], :opts {:foo :dude3}}],
+ :args ["bar" "arg1"]}
+ (cli/dispatch
+ table
+ ["--foo" "dude1" "foo" "--foo" "dude2" "bar" "--foo" "dude3" "bar" "arg1"])))))
+
+ (testing "with colon options"
+ (d/deflet
+ (def table [{:cmds ["foo"] :fn identity}])
+ (is (= "my-file.edn" (-> (cli/dispatch
+ table
+ ["foo" ":deps-file" "my-file.edn"])
+ :opts :deps-file)))))
+
+ (testing "choose most specific"
+ (d/deflet
+ (def table [{:cmds ["foo" "bar"] :fn identity}
+ {:cmds ["foo" "baz"] :fn identity}
+ {:cmds ["foo"] :fn identity}])
+ (is (= ["foo" "bar"] (-> (cli/dispatch
+ table
+ ["foo" "bar" "baz" "--dude" "1"])
+ :dispatch)))))
+
+ (testing "spec can be overriden"
+ (d/deflet
+ (def table [{:cmds ["foo" "bar"] :fn identity :spec {:version {:coerce :string}
+ }}
+ {:cmds ["foo"] :fn identity :spec {:version {:coerce :boolean}
+ :dude {:coerce :boolean}}}])
+ (is (submap? {:opts {:version true}, :args ["2010"]}
+ (cli/dispatch
+ table
+ ["foo" "--version" "2010"])))
+ (is (= "2010" (-> (cli/dispatch
+ table
+ ["foo" "bar" "--version" "2010"])
+ :opts :version)))
+ (is (= {:dude true :version "2010"}
+ (-> (cli/dispatch
+ table
+ ["foo" "--dude" "bar" "--version" "2010"])
+ :opts)))
+ (testing "specific spec replaces less specific spec (no merge)"
+ (is (= {:dude "some-value"}
+ (-> (cli/dispatch
+ table
+ ["foo" "bar" "--dude" "some-value"])
+ :opts))))
+
+ (def table [{:cmds ["foo"] :fn identity
+ :spec {:version {:coerce :boolean}}
+ :args->opts [:some-option]}
+ {:cmds ["foo" "bar"]
+ :fn identity
+ :spec {:version {:coerce :string}}}])
+ (testing "subcommand wins from args->opts"
+ (is (= {:dispatch ["foo" "bar"], :opts {:version "2000"}, :args ["some-arg"]}
+ (-> (cli/dispatch
+ table
+ ["foo" "bar" "--version" "2000" "some-arg"]))))))))
+
+(deftest table->tree-test
+ (testing "internal represenation"
+ (is (= {:cmd
+ {"foo"
+ {:cmd
+ {"bar"
+ {:spec {:baz {:coerce :boolean}},
+ :fn identity
+ :cmd
+ {"baz"
+ {:spec {:quux {:coerce :keyword}},
+ :fn identity}}}}}}}
+ (#'cli/table->tree [{:cmds ["foo" "bar"]
+ :spec {:baz {:coerce :boolean}}
+ :fn identity}
+ {:cmds ["foo" "bar" "baz"]
+ :spec {:quux {:coerce :keyword}}
+ :fn identity}])))))
(deftest no-keyword-opts-test (is (= {:query [:a :b :c]}
(cli/parse-opts