Fix #216: an interior hyphen is one option, not a cluster

CHANGELOG.md

@@ -4,6 +4,12 @@ For breaking changes, check [here](#breaking-changes).
 
 [Babashka CLI](https://github.com/babashka/cli): turn Clojure functions into CLIs!
 
+## Unreleased
+
+- A short option that declares a non-boolean `:coerce` takes the rest of its token as its value, like getopt: `-J-Dfoo=bar` binds `"-Dfoo=bar"`, `-p80` binds `80`. One leading `=` is stripped, like `--foo=bar`. Flag letters may precede the valued option in a cluster: with `:b` a flag and `:a` valued, `-ba x` parses as `-b -a x`
+- [#216](https://github.com/babashka/cli/issues/216): in a cluster of flags, where no letter takes a value, an interior hyphen is an error instead of silently ending option parsing. With an `:error-fn` the remaining letters still parse
+- Fix: a value bound with `--foo=val` may start with a hyphen: `--foo=-bar` binds `"-bar"` instead of reporting a missing value
+
 ## 0.12.87
 
 - `dispatch`: the command named on the command line wins over the `:exec-args` of its ancestors. A value the user typed at an ancestor level still wins over both

bb.edn

@@ -68,8 +68,10 @@
                :task (do (run 'npm-build)
                          (shell "npm publish"))}
 
-  publish {:doc "Publish to clojars and npm. Pass --bump to run bump-release first"
+  publish {:doc "Publish to clojars and npm, then push. Pass --bump to run bump-release first"
            :task (do (when (:bump cmd-line-opts)
                        (run 'bump-release))
                      (clojure "-T:build deploy")
-                     (run 'npm-publish))}}}
+                     (run 'npm-publish)
+                     ;; bump-release pushes the tag, the commit it points at needs this
+                     (shell "git push"))}}}

src/babashka/cli.cljc

@@ -633,12 +633,18 @@
   ;;  bar remains an "arg"
   ;; parsed "arg"s can only be leading or trailing.
   (let [parse-opts (resolve-opts opts) ;; disambiguate from cli opts (without making fn sig odd-looking)
+        error-fn (->error-fn (:spec parse-opts) (:error-fn parse-opts))
         {:keys [coerce collect no-keyword-opts repeated-opts]} parse-opts
         aliases (or (:alias parse-opts) (:aliases parse-opts))
         spec-map (::spec-map parse-opts)
         alias-keys (set (concat (keys aliases) (keep :alias (vals spec-map))))
         known-keys (set (concat (keys spec-map) (vals aliases) (keys coerce)))
         expects-bool-val? (fn [opt-key] (#{:boolean :bool} (coerce-coerce-fn (get coerce opt-key))))
+        ;; a letter that takes an attached value: declared with a non-boolean :coerce
+        valued-letter? (fn [c]
+                         (let [k (keyword (str c))
+                               ck (or (get aliases k) k)]
+                           (and (contains? coerce ck) (not (expects-bool-val? ck)))))
         track-ivs (fn [implicit-values current-opt added]
                     ;; we handle implicit trues here only, :add-opt-and-val below covers implicit false
                     (if (not= current-opt added)
@@ -680,8 +686,7 @@
         (if (and (::dispatch-tree parse-opts) (seq leading-pos-args))
           [(vary-meta {} assoc-in [:org.babashka/cli :args] (into (vec leading-pos-args) args)) nil nil #{} []]
           (loop [acc acc0
-                 #_{:clj-kondo/ignore [:unused-binding]}
-                 recur-action nil                     ;; for debugging only
+                 recur-action nil                     ;; how the previous iteration recurred
                  open-opt last-bound                  ;; the cli option keyword we are working on
                  valued-opt last-bound                ;; the cli option keyword that has been given value(s) (but not necessarily all values)
                  mode (when no-keyword-opts :hyphens) ;; :hyphens --foo/-f else :keywords :foo
@@ -699,7 +704,10 @@
                     boolean-opt? (expects-bool-val? open-opt)
                     {:keys [hyphen-opt composite-opt kwd-opt mode fst-colon]}
                     (analyze-arg arg mode open-opt boolean-opt? valued-opt known-keys alias-keys)]
-                    (if (or hyphen-opt kwd-opt)
+                    (if (and (or hyphen-opt kwd-opt)
+                             ;; a value bound by --foo=val or -fval is a value,
+                             ;; also when it starts with a hyphen: --foo=-bar
+                             (not= :injected-bound-val recur-action))
                       ;; arg is -f/-foo or :foo
                       (let [long-opt? (str/starts-with? arg "--")
                             eo-all-opts? (and long-opt? (= "--" arg))]
@@ -713,14 +721,46 @@
                                            (subs arg 2)
                                            (str/replace arg #"^(:|-|)" ""))
                                 ;; split on the first = only: --header=k=v binds "k=v"
-                                [opt-name opt-val] (if long-opt?
-                                                     (str/split opt-name #"=" 2)
-                                                     [opt-name])
+                                ;; -ab where :a takes a value binds "b". getopt
+                                ;; has the same rule: declaring "a:" (the colon
+                                ;; means a takes an argument) makes -ab bind "b".
+                                ;; One leading = is stripped, like
+                                ;; --foo=bar: -a=b binds "b". Flag letters before
+                                ;; the valued one stay flags: -ba x
+                                opt-name-count (count opt-name)
+                                attached (when (and (not long-opt?)
+                                                    (str/starts-with? arg "-")
+                                                    (> opt-name-count 1))
+                                           (loop [i 0]
+                                             (when (< i opt-name-count)
+                                               (let [c (nth opt-name i)]
+                                                 (cond (= \- c) nil
+                                                       (valued-letter? c)
+                                                       {:flags (subs opt-name 0 i)
+                                                        :letter (str c)
+                                                        :rest (let [r (subs opt-name (inc i))]
+                                                                (if (str/starts-with? r "=") (subs r 1) r))}
+                                                       :else (recur (inc i)))))))
+                                [opt-name opt-val] (cond long-opt?
+                                                         (str/split opt-name #"=" 2)
+                                                         (and attached (= "" (:flags attached)) (seq (:rest attached)))
+                                                         [(:letter attached) (:rest attached)]
+                                                         :else [opt-name])
                                 opt-kw (keyword opt-name)
                                 opt-kw-for-alias (when-not long-opt? (get aliases opt-kw))
                                 parsed-opt (or opt-kw-for-alias opt-kw)
                                 ;; the literal option the user typed (sans any =value)
                                 literal-opt (if long-opt? (str "--" opt-name) arg)]
+                            (if (and attached (seq (:flags attached)))
+                              ;; continue loop: -ba x becomes -b true -a x
+                              (recur acc
+                                     :injected-attached-flags
+                                     nil nil
+                                     mode
+                                     (concat (mapcat (fn [c] [(str "-" c) true]) (:flags attached))
+                                             [(str "-" (:letter attached) (:rest attached))]
+                                             (next args))
+                                     a->o implicit-values opt-parse-order)
                             (if opt-val
                               ;; continue loop: inject val for --foo=val into args
                               (recur (stamp (maybe-close-open-opt acc open-opt valued-opt opt-val-collector) parsed-opt literal-opt)
@@ -739,8 +779,15 @@
                                         negated-opt?)               ;; --no-foo
                                   ;; implicit true or false
                                   (if (and (not opt-kw-for-alias) composite-opt)
-                                    ;; continue loop: expand -abc to: -a true, -b true, -c true onto args
-                                    (let [expanded (mapcat (fn [c] [(str "-" c) true]) (name parsed-opt))]
+                                    ;; continue loop: expand -abc to: -a true, -b true, -c true onto args.
+                                    ;; An interior hyphen is an error, as in getopt and tools.cli, and
+                                    ;; the remaining letters still parse
+                                    (let [cluster (name parsed-opt)
+                                          _ (when (str/includes? cluster "-")
+                                              (error-fn {:cause :cluster
+                                                         :msg (str "Interior hyphen in option cluster -" cluster)
+                                                         :option parsed-opt}))
+                                          expanded (mapcat (fn [c] [(str "-" c) true]) (remove #{\-} cluster))]
                                       (recur acc
                                              :injected-expanded-composite
                                              nil nil ;; start afresh for open-opt and valued-opt
@@ -762,7 +809,7 @@
                                          parsed-opt nil
                                          mode next-args a->o
                                          (track-ivs implicit-values open-opt valued-opt)
-                                         (track-kpo opt-parse-order parsed-opt))))))))
+                                         (track-kpo opt-parse-order parsed-opt)))))))))
                       ;; arg (is not option)
                       (let [done-parsing-options? (or
                                                    ;; boolean with next arg that is not true/false ends

test/babashka/cli_test.cljc

@@ -296,6 +296,40 @@
       (is (nil? (:foo (cli/parse-opts [] {:spec {:foo {:default 1}}
                                           :exec-args {:foo nil}})))))))
 
+(deftest attached-short-value-test
+  (testing "a declared valued short option takes the rest of the token, like getopt a:"
+    (is (= {:a "b"} (cli/parse-opts ["-ab"] {:coerce {:a :string}})))
+    (is (= {:J "-Dfoo=bar" :main "app"}
+           (cli/parse-opts ["-J-Dfoo=bar" "--main" "app"] {:coerce {:J :string}})))
+    (is (= {:J ["-Da" "-Db"]} (cli/parse-opts ["-J-Da" "-J-Db"] {:coerce {:J [:string]}}))))
+  (testing "one leading = is stripped, like --foo=bar"
+    (is (= {:a "b"} (cli/parse-opts ["-a=b"] {:coerce {:a :string}})))
+    (is (= {:a "b=c"} (cli/parse-opts ["-a=b=c"] {:coerce {:a :string}}))))
+  (testing "flag letters before the valued one stay flags"
+    (is (= {:b true :a "x"} (cli/parse-opts ["-ba" "x"] {:coerce {:a :string :b :boolean}}))))
+  (testing "a valued letter with nothing attached and nothing following is an error"
+    (is (thrown-with-msg? #?(:cljd Object :default Exception)
+                          #"Missing value"
+                          (cli/parse-opts ["-ba"] {:coerce {:a :string :b :boolean}}))))
+  (testing "an alias binds under its long name"
+    (is (= {:jvm-opts ["-Xmx4g"]}
+           (cli/parse-opts ["-J-Xmx4g"] {:spec {:jvm-opts {:alias :J :coerce [:string]}}}))))
+  (testing "without a value declaration a cluster stays a cluster"
+    (is (= {:a true :b true} (cli/parse-opts ["-ab"]))))
+  (testing "a bound value may start with a hyphen, also in the long form"
+    (is (= {:foo "-bar"} (cli/parse-opts ["--foo=-bar"])))))
+
+(deftest interior-hyphen-cluster-test
+  (testing "an interior hyphen in a cluster is an error, not a silent stop"
+    (is (thrown-with-msg? #?(:cljd Object :default Exception)
+                          #"Interior hyphen in option cluster -a-b"
+                          (cli/parse-args ["-a-b" "--foo" "1"]))))
+  (testing "with an :error-fn the letters still parse, like getopt"
+    (is (= {:a true :b true :foo 1}
+           (:opts (cli/parse-args ["-a-b" "--foo" "1"] {:error-fn identity})))))
+  (testing "a plain cluster still expands"
+    (is (= {:a true :b true :foo 1} (:opts (cli/parse-args ["-ab" "--foo" "1"]))))))
+
 (deftest args-test
   (is (submap? {:foo true} (cli/parse-opts ["--foo" "--"])))
   (let [res (cli/parse-opts ["--foo" "--" "a"])]