Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

auto-completions for bb.cli/dispatch #95

Open
wants to merge 6 commits into
base: main
Choose a base branch
from
Open

auto-completions for bb.cli/dispatch #95

Show file tree
Hide file tree
Changes from 5 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
d030850
auto-completions for bb.cli/dispatch
Sohalt Mar 13, 2024
2a65b99
complete-options
Sohalt Mar 21, 2024
c12668a
remove test
Sohalt Mar 21, 2024
6c7d7f0
disable completion test on windows
Sohalt Mar 21, 2024
38f5c16
fix spec
Sohalt Mar 21, 2024
00e4a2a
Use opts under `org.babashka.cli` ns
Sohalt Mar 21, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
198 changes: 182 additions & 16 deletions src/babashka/cli.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,8 @@
#?(:clj [clojure.edn :as edn]
:cljs [cljs.reader :as edn])
[babashka.cli.internal :as internal]
[clojure.string :as str])
[clojure.string :as str]
[clojure.set :as set])
#?(:clj (:import (clojure.lang ExceptionInfo))))

#?(:clj (set! *warn-on-reflection* true))
Expand Down Expand Up @@ -257,6 +258,9 @@
:kwd-opt kwd-opt?
:fst-colon fst-colon?}))

(declare print-completion-shell-snippet)
(declare print-opts-completions)

(defn parse-opts
"Parse the command line arguments `args`, a seq of strings.
Instead of a leading `:` either `--` or `-` may be used as well.
Expand Down Expand Up @@ -321,6 +325,19 @@
(-> {:spec spec :type :org.babashka/cli}
(merge data)
error-fn*))
[opt shell cmdline] args
_ (case opt
"--babashka.cli/completion-snippet"
(if-let [command-name (get-in opts [:completion :command])]
(do (print-completion-shell-snippet (keyword shell) command-name)
(System/exit 0))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I prefer not to call System/exit in function that are supposed to be non-side-effecting. I'd rather throw exceptions or whatever

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We need to short circuit all following execution in this case though, since we're printing the shell completion snippet and any other code running after this might print stuff that messes this up. It only happens when you pass the internal --babashka.cli/completion-snippet opt, so regular user code should never hit this.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You don't need to short circuit if you just put the logic after all the parsing logic though?
Also removing the System/exit stuff makes it more REPL friendly

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If I put the code after the parsing logic the consuming code could still print extra stuff. e.g.

(defn -main [& args]
  (cli/parse-opts args opts)
  (println "this does not belong in the completions script"))

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The alternative would be to make it the responsibility of the user to call print-completion-shell-snippet (and make sure nothing else is printed in that case)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Well, we control format-opts so we can decide to filter those options out, right?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure, but then you'll have a format-opts, that magically swallows some options.
I also don't particularly like the magic in parse-opts, but at least that means you get completions without any setup on your part.
Changing format-opts means you still have magic and need to do setup.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm also ok with just providing the complete * functions and having the user wire everything up themselves. Then it's even more work, but absolutely no magic.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Well, we control format-opts so we can decide to filter those options out, right?

Or do you mean the caller filters them out?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

magically swallows some options

The fact that org.babashka.cli/... options are internal, makes this non-magic imo. Users of this library should never make up options with that namespace themselves

(binding [*out* *err*]
(println "Need `:completion {:command \"<name>\"}` in opts to support shell completions")
(System/exit 1)))
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Same here

"--babashka.cli/complete"
Sohalt marked this conversation as resolved.
Show resolved Hide resolved
(do (print-opts-completions (keyword shell) opts cmdline)
(System/exit 0))
:noop)
{:keys [cmds args]} (parse-cmds args)
{new-args :args
a->o :args->opts}
Expand Down Expand Up @@ -590,8 +607,150 @@
{} table))

(comment
(table->tree [{:cmds [] :fn identity}])
)
(table->tree [{:cmds [] :fn identity}]))

;; completion
(defn format-long-opt [k]
(str "--" (kw->str k)))
(defn format-short-opt [k]
(str "-" (kw->str k)))

(defn possibilities [cmd-tree]
(concat (keys (:cmd cmd-tree))
(map format-long-opt (keys (:spec cmd-tree)))
(map format-short-opt (keep :alias (vals (:spec cmd-tree))))))

(defn true-prefix? [prefix s]
(and (< (count prefix) (count s))
(str/starts-with? s prefix)))

(defn second-to-last [xs]
(when (>= (count xs) 2) (nth xs (- (count xs) 2))))

;; TODO complete option values
(def possible-values (constantly []))

(defn strip-prefix [prefix s]
(if (str/starts-with? s prefix)
(subs s (count prefix))
s))

(defn bool-opt? [o opts]
(let [long-opt? (str/starts-with? o "--")
opt-kw (if long-opt?
(keyword (strip-prefix "--" o))
(get-in opts [:alias (keyword (strip-prefix "-" o))]))]
(= :boolean (get-in opts [:coerce opt-kw]))))

(defn is-gnu-option? [s]
(and s (str/starts-with? s "-")))

(defn complete-options
"given an opts map as expected by parse-opts and input as a list of tokens,
returns possible tokens to complete the input"
[opts input]
(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))
known-keys (set (concat (keys (if (map? spec)
spec (into {} spec)))
(vals aliases)
(keys coerce-opts)))
{parsed-opts :opts :keys [args err]} (try (parse-args input opts)
(catch clojure.lang.ExceptionInfo _ {:err :error}))
to-complete (last input)]
(cond
(and args (not (str/blank? (first args)))) []
:else
(let [previous-token (second-to-last input)
;; don't suggest options which we already have parsed
possible-options (set/difference known-keys (set (keys parsed-opts)))
;; generate string representation of possible options
possible-completions (concat (map format-long-opt possible-options)
(keep (fn [option-name]
(when-let [alias (some (fn [[alias long]] (when (= long option-name) alias)) aliases)]
(format-short-opt alias)))
possible-options))]
(if (and (is-gnu-option? previous-token) (not (bool-opt? previous-token opts)))
(possible-values previous-token to-complete opts)
(filter (partial true-prefix? to-complete) possible-completions))))))

(defn complete-tree
"given a CLI spec in tree form and input as a list of tokens,
returns possible tokens to complete the input"
[cmd-tree input]
(let [[head & tail] input
head (or head "")
subtree (get-in cmd-tree [:cmd head])]
(if (and subtree (first tail))
;; matching command -> descend tree
(complete-tree subtree tail)
(if (is-gnu-option? head)
(let [{:keys [args]} (try (parse-args input cmd-tree)
(catch clojure.lang.ExceptionInfo _))]
(if (and args (not (str/blank? (first args))))
;; parsed/consumed options and still have args left -> descend tree
(complete-tree cmd-tree args)
;; no more args -> last input is (part of) an opt or opt value or empty string
(let [opts (spec->opts (:spec cmd-tree))
to-complete (last input)
previous-token (second-to-last input)
incomplete-option? (and (is-gnu-option? previous-token) (not (bool-opt? previous-token opts)))
possible-commands (if incomplete-option? [] (filter (partial true-prefix? to-complete) (keys (:cmd cmd-tree))))
possible-options (complete-options opts input)]
(concat possible-commands possible-options))))
(filter (partial true-prefix? head) (possibilities cmd-tree))))))

(defn complete [cmd-table input]
(complete-tree (table->tree cmd-table) input))

(defn generate-completion-shell-snippet [type program-name]
(case type
:bash (format "_babashka_cli_dynamic_completion()
{
source <( \"$1\" --babashka.cli/complete \"bash\" \"${COMP_WORDS[*]// / }\" )
}
complete -o nosort -F _babashka_cli_dynamic_completion %s
" program-name)
:zsh (format "#compdef %s
source <( \"${words[1]}\" --babashka.cli/complete \"zsh\" \"${words[*]// / }\" )
" program-name)
:fish (format "function _babashka_cli_dynamic_completion
set --local COMP_LINE (commandline --cut-at-cursor)
%s --babashka.cli/complete fish $COMP_LINE
end
complete --command %s --no-files --arguments \"(_babashka_cli_dynamic_completion)\"
" program-name program-name)))

(defn print-completion-shell-snippet [type program-name]
(print (generate-completion-shell-snippet type program-name)))

(defn format-completion [shell {:keys [completion description]}]
(case shell
:bash (format "COMPREPLY+=( \"%s\" )" completion)
:zsh (str "compadd" (when description (str " -x \"" description "\"")) " -- " completion)
:fish completion))

(defn print-opts-completions [shell opts cmdline]
(let [[_program-name & to-complete] (str/split (str/triml cmdline) #" +" -1)
completions (complete-options opts to-complete)]
(doseq [completion completions]
(println (format-completion shell {:completion completion})))))

(defn print-dispatch-completions [shell tree cmdline]
(let [[_program-name & to-complete] (str/split (str/triml cmdline) #" +" -1)
completions (complete-tree tree to-complete)]
(doseq [completion completions]
(println (format-completion shell {:completion completion})))))

;; dispatch

(defn- deep-merge [a b]
(reduce (fn [acc k] (update acc k (fn [v]
Expand Down Expand Up @@ -656,19 +815,26 @@
([tree args]
(dispatch-tree tree args nil))
([tree args opts]
(let [{:as res :keys [cmd-info error available-commands]}
(dispatch-tree' tree args opts)
error-fn (or (:error-fn opts)
(fn [{:keys [msg] :as data}]
(throw (ex-info msg data))))]
(case error
(:no-match :input-exhausted)
(error-fn (merge
{:type :org.babashka/cli
:cause error
:all-commands available-commands}
(select-keys res [:wrong-input :opts :dispatch])))
nil ((:fn cmd-info) (dissoc res :cmd-info))))))
(let [command-name (get-in opts [:completion :command])
[opt shell cmdline] args]
(case opt
"--babashka.cli/completion-snippet"
(print-completion-shell-snippet (keyword shell) command-name)
"--babashka.cli/complete"
(print-dispatch-completions (keyword shell) tree cmdline)
(let [{:as res :keys [cmd-info error available-commands]}
(dispatch-tree' tree args opts)
error-fn (or (:error-fn opts)
(fn [{:keys [msg] :as data}]
(throw (ex-info msg data))))]
(case error
(:no-match :input-exhausted)
(error-fn (merge
{:type :org.babashka/cli
:cause error
:all-commands available-commands}
(select-keys res [:wrong-input :opts :dispatch])))
nil ((:fn cmd-info) (dissoc res :cmd-info))))))))

(defn dispatch
"Subcommand dispatcher.
Expand Down
124 changes: 124 additions & 0 deletions test/babashka/cli/completion_test.clj
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,124 @@
(ns babashka.cli.completion-test
(:require [babashka.cli :as cli :refer [complete-options complete]]
[babashka.fs :as fs]
[clojure.java.io :as io]
[clojure.test :refer :all]))

(def cmd-table
[{:cmds ["foo"] :spec {:foo-opt {:coerce :string
:alias :f}
:foo-opt2 {:coerce :string}
:foo-flag {:coerce :boolean
:alias :l}}}
{:cmds ["foo" "bar"] :spec {:bar-opt {:coerce :keyword}
:bar-flag {:coerce :boolean}}}
{:cmds ["bar"]}
{:cmds ["bar-baz"]}])

(def opts {:spec {:aopt {:alias :a
:coerce :string}
:aopt2 {:coerce :string
:validate #{"aval2"}}
:bflag {:alias :b
:coerce :boolean}}})

(deftest complete-options-test
(is (= #{"--aopt" "--aopt2" "--bflag" "-b" "-a"} (set (complete-options opts [""]))))
(is (= #{"--aopt" "--aopt2" "--bflag" "-b" "-a"} (set (complete-options opts ["-"]))))
(is (= #{"--aopt" "--aopt2" "--bflag"} (set (complete-options opts ["--"]))))
(is (= #{"--aopt" "--aopt2"} (set (complete-options opts ["--a"]))))
(is (= #{"--bflag"} (set (complete-options opts ["--b"]))))
(is (= #{} (set (complete-options opts ["--bflag"]))))
(is (= #{"--aopt" "--aopt2" "-a"} (set (complete-options opts ["--bflag" ""]))))
(is (= #{} (set (complete-options opts ["--aopt" ""]))))
(is (= #{} (set (complete-options opts ["--aopt" "aval"]))))
(is (= #{"--aopt2" "--bflag" "-b"} (set (complete-options opts ["--aopt" "aval" ""]))))
(is (= #{"--aopt" "--bflag" "-b" "-a"} (set (complete-options opts ["--aopt2" "aval2" ""]))))
(testing "failing options"
(is (= #{} (set (complete-options opts ["--aopt" "-"]))))
(is (= #{} (set (complete-options opts ["--aopt" "--bflag"]))))
;;FIXME
#_(is (= #{} (set (complete-options opts ["--aopt" "--bflag" ""])))))
(testing "invalid option value"
;;FIXME
#_(is (= #{} (set (complete-options opts ["--aopt2" "invalid" ""])))))
(testing "complete option with same prefix"
(is (= #{"--aopt" "--aopt2"} (set (complete-options opts ["--a"]))))
(is (= #{"--aopt2"} (set (complete-options opts ["--aopt"]))))))

(deftest completion-test
(testing "complete commands"
(is (= #{"foo" "bar" "bar-baz"} (set (complete cmd-table [""]))))
(is (= #{"bar" "bar-baz"} (set (complete cmd-table ["ba"]))))
(is (= #{"bar-baz"} (set (complete cmd-table ["bar"]))))
(is (= #{"foo"} (set (complete cmd-table ["f"])))))

(testing "no completions for full command"
(is (= #{} (set (complete cmd-table ["foo"])))))

(testing "complete subcommands and options"
(is (= #{"bar" "-f" "--foo-opt" "--foo-opt2" "-l" "--foo-flag"} (set (complete cmd-table ["foo" ""])))))

(testing "complete suboption"
(is (= #{"-f" "--foo-opt" "--foo-opt2" "-l" "--foo-flag"} (set (complete cmd-table ["foo" "-"])))))

(testing "complete short-opt"
(is (= #{} (set (complete cmd-table ["foo" "-f"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" ""]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "foo-val"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "bar"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "foo-flag"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "foo-opt2"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "123"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" ":foo"]))))
(is (= #{} (set (complete cmd-table ["foo" "-f" "true"]))))
(is (= #{"bar" "--foo-opt2" "-l" "--foo-flag"} (set (complete cmd-table ["foo" "-f" "foo-val" ""])))))

(testing "complete option with same prefix"
(is (= #{"--foo-opt" "--foo-opt2" "--foo-flag"} (set (complete cmd-table ["foo" "--foo"]))))
(is (= #{"--foo-opt2"} (set (complete cmd-table ["foo" "--foo-opt"])))))

(testing "complete long-opt"
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt2"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" ""]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "foo-val"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "bar"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "foo-flag"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "foo-opt2"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "123"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" ":foo"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-opt" "true"]))))
(is (= #{"bar" "--foo-opt2" "-l" "--foo-flag"} (set (complete cmd-table ["foo" "--foo-opt" "foo-val" ""])))))

(is (= #{"--foo-flag"} (set (complete cmd-table ["foo" "--foo-f"]))))

(testing "complete short flag"
(is (= #{} (set (complete cmd-table ["foo" "-l"]))))
(is (= #{"bar" "-f" "--foo-opt" "--foo-opt2"} (set (complete cmd-table ["foo" "-l" ""])))))

(testing "complete long flag"
(is (= #{} (set (complete cmd-table ["foo" "--foo-flag"]))))
(is (= #{"bar" "-f" "--foo-opt" "--foo-opt2"} (set (complete cmd-table ["foo" "--foo-flag" ""])))))

(is (= #{"-f" "--foo-opt" "--foo-opt2"} (set (complete cmd-table ["foo" "--foo-flag" "-"]))))
(is (= #{"bar"} (set (complete cmd-table ["foo" "--foo-flag" "b"]))))

(testing "complete subcommand"
(is (= #{"--bar-opt" "--bar-flag"} (set (complete cmd-table ["foo" "--foo-flag" "bar" ""]))))
(is (= #{"--bar-opt" "--bar-flag"} (set (complete cmd-table ["foo" "--foo-flag" "bar" "-"]))))
(is (= #{"--bar-opt" "--bar-flag"} (set (complete cmd-table ["foo" "--foo-flag" "bar" "--"]))))
(is (= #{"--bar-opt" "--bar-flag"} (set (complete cmd-table ["foo" "--foo-flag" "bar" "--bar-"]))))
(is (= #{"--bar-opt"} (set (complete cmd-table ["foo" "--foo-flag" "bar" "--bar-o"]))))
(is (= #{} (set (complete cmd-table ["foo" "--foo-flag" "bar" "--bar-opt" "a"]))))
(is (= #{"--bar-flag"} (set (complete cmd-table ["foo" "--foo-flag" "bar" "--bar-opt" "bar-val" ""]))))))


(deftest dispatch-completion-test
(when-not (fs/windows?)
(is (= (slurp (io/resource "resources/completion/completion.zsh")) (with-out-str (cli/dispatch cmd-table ["--babashka.cli/completion-snippet" "zsh"] {:completion {:command "myprogram"}})))) ;
(is (= (slurp (io/resource "resources/completion/completion.bash")) (with-out-str (cli/dispatch cmd-table ["--babashka.cli/completion-snippet" "bash"] {:completion {:command "myprogram"}}))))
(is (= (slurp (io/resource "resources/completion/completion.fish")) (with-out-str (cli/dispatch cmd-table ["--babashka.cli/completion-snippet" "fish"] {:completion {:command "myprogram"}}))))

(is (= "compadd -- foo\n" (with-out-str (cli/dispatch cmd-table ["--babashka.cli/complete" "zsh" "myprogram f"] {:completion {:command "myprogram"}}))))
(is (= "COMPREPLY+=( \"foo\" )\n" (with-out-str (cli/dispatch cmd-table ["--babashka.cli/complete" "bash" "myprogram f "] {:completion {:command "myprogram"}}))))
(is (= "foo\n" (with-out-str (cli/dispatch cmd-table ["--babashka.cli/complete" "fish" "myprogram f "] {:completion {:command "myprogram"}}))))))
5 changes: 5 additions & 0 deletions test/resources/completion/completion.bash
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
_babashka_cli_dynamic_completion()
{
source <( "$1" --babashka.cli/complete "bash" "${COMP_WORDS[*]// / }" )
}
complete -o nosort -F _babashka_cli_dynamic_completion myprogram
5 changes: 5 additions & 0 deletions test/resources/completion/completion.fish
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,5 @@
function _babashka_cli_dynamic_completion
set --local COMP_LINE (commandline --cut-at-cursor)
myprogram --babashka.cli/complete fish $COMP_LINE
end
complete --command myprogram --no-files --arguments "(_babashka_cli_dynamic_completion)"
2 changes: 2 additions & 0 deletions test/resources/completion/completion.zsh
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,2 @@
#compdef myprogram
source <( "${words[1]}" --babashka.cli/complete "zsh" "${words[*]// / }" )
Loading