|
4 | 4 | #?(:clj [clojure.edn :as edn] |
5 | 5 | :cljs [cljs.reader :as edn]) |
6 | 6 | [babashka.cli.internal :as internal] |
7 | | - [clojure.string :as str]) |
| 7 | + [clojure.string :as str] |
| 8 | + [clojure.set :as set]) |
8 | 9 | #?(:clj (:import (clojure.lang ExceptionInfo)))) |
9 | 10 |
|
10 | 11 | #?(:clj (set! *warn-on-reflection* true)) |
|
590 | 591 | {} table)) |
591 | 592 |
|
592 | 593 | (comment |
593 | | - (table->tree [{:cmds [] :fn identity}]) |
594 | | - ) |
| 594 | + (table->tree [{:cmds [] :fn identity}])) |
| 595 | + |
| 596 | +;; completion |
| 597 | +(defn format-long-opt [k] |
| 598 | + (str "--" (kw->str k))) |
| 599 | +(defn format-short-opt [k] |
| 600 | + (str "-" (kw->str k))) |
| 601 | + |
| 602 | +(defn possibilities [cmd-tree] |
| 603 | + (concat (keys (:cmd cmd-tree)) |
| 604 | + (map format-long-opt (keys (:spec cmd-tree))) |
| 605 | + (map format-short-opt (keep :alias (vals (:spec cmd-tree)))))) |
| 606 | + |
| 607 | +(defn true-prefix? [prefix s] |
| 608 | + (and (< (count prefix) (count s)) |
| 609 | + (str/starts-with? s prefix))) |
| 610 | + |
| 611 | +(defn second-to-last [xs] |
| 612 | + (when (>= (count xs) 2) (nth xs (- (count xs) 2)))) |
| 613 | + |
| 614 | +(def possible-values (constantly [])) |
| 615 | + |
| 616 | +(defn strip-prefix [prefix s] |
| 617 | + (if (str/starts-with? s prefix) |
| 618 | + (subs s (count prefix)) |
| 619 | + s)) |
| 620 | + |
| 621 | +(defn bool-opt? [o spec] |
| 622 | + (let [long-opt? (str/starts-with? o "--") |
| 623 | + opt-kw (if long-opt? |
| 624 | + (keyword (strip-prefix "--" o)) |
| 625 | + (some (fn [[k v]] (when (= (keyword (strip-prefix "-" o)) (:alias v)) k)) spec))] |
| 626 | + (= :boolean (get-in spec [opt-kw :coerce])))) |
| 627 | + |
| 628 | +(defn is-gnu-option? [s] |
| 629 | + (and s (str/starts-with? s "-"))) |
| 630 | + |
| 631 | +(defn complete-tree |
| 632 | + "given a CLI spec in tree form and input as a list of tokens, |
| 633 | + returns possible tokens to complete the input" |
| 634 | + [cmd-tree input] |
| 635 | + (let [[head & tail] input |
| 636 | + head (or head "") |
| 637 | + subtree (get-in cmd-tree [:cmd head])] |
| 638 | + (if (and subtree (first tail)) |
| 639 | + ;; matching command -> descend tree |
| 640 | + (complete-tree subtree tail) |
| 641 | + (if (is-gnu-option? head) |
| 642 | + (let [{:keys [args opts err]} (try (parse-args input cmd-tree) |
| 643 | + (catch clojure.lang.ExceptionInfo _ {:err :error}))] |
| 644 | + (if (and args (not (str/blank? (first args)))) |
| 645 | + ;; parsed/consumed options and still have args left -> descend tree |
| 646 | + (complete-tree cmd-tree args) |
| 647 | + ;; no more args -> last input is (part of) an opt or opt value or empty string |
| 648 | + (let [to-complete (last input) |
| 649 | + previous-token (second-to-last input)] |
| 650 | + (if (and (is-gnu-option? previous-token) (not (bool-opt? previous-token (:spec cmd-tree)))) |
| 651 | + ;; complete value |
| 652 | + (possible-values previous-token) |
| 653 | + (let [possible-commands (keys (:cmd cmd-tree)) |
| 654 | + ;; don't suggest options which we already have parsed |
| 655 | + possible-options (set/difference (set (keys (:spec cmd-tree))) (set (keys opts))) |
| 656 | + ;; generate string representation of possible options |
| 657 | + possible-completions (concat possible-commands |
| 658 | + (map format-long-opt possible-options) |
| 659 | + (keep (fn [option-name] |
| 660 | + (when-let [alias (get-in cmd-tree [:spec option-name :alias])] |
| 661 | + (format-short-opt alias))) |
| 662 | + possible-options))] |
| 663 | + (filter (partial true-prefix? to-complete) possible-completions)))))) |
| 664 | + (filter (partial true-prefix? head) (possibilities cmd-tree)))))) |
| 665 | + |
| 666 | +(defn complete [cmd-table input] |
| 667 | + (complete-tree (table->tree cmd-table) input)) |
| 668 | + |
| 669 | + |
| 670 | +(defn generate-completion-shell-snippet [type program-name] |
| 671 | + (case type |
| 672 | + :bash (format "_babashka_cli_dynamic_completion() |
| 673 | +{ |
| 674 | + source <( \"$1\" --babashka.cli/complete \"bash\" \"${COMP_WORDS[*]// / }\" ) |
| 675 | +} |
| 676 | +complete -o nosort -F _babashka_cli_dynamic_completion %s |
| 677 | +" program-name) |
| 678 | + :zsh (format "#compdef %s |
| 679 | +source <( \"${words[1]}\" --babashka.cli/complete \"zsh\" \"${words[*]// / }\" ) |
| 680 | +" program-name) |
| 681 | + :fish (format "function _babashka_cli_dynamic_completion |
| 682 | + set --local COMP_LINE (commandline --cut-at-cursor) |
| 683 | + %s --babashka.cli/complete fish $COMP_LINE |
| 684 | +end |
| 685 | +complete --command %s --no-files --arguments \"(_babashka_cli_dynamic_completion)\" |
| 686 | +" program-name program-name))) |
| 687 | + |
| 688 | +(defn print-completion-shell-snippet [type program-name] |
| 689 | + (print (generate-completion-shell-snippet type program-name))) |
| 690 | + |
| 691 | +(defn format-completion [shell {:keys [completion description]}] |
| 692 | + (case shell |
| 693 | + :bash (format "COMPREPLY+=( \"%s\" )" completion) |
| 694 | + :zsh (str "compadd" (when description (str " -x \"" description "\"")) " -- " completion) |
| 695 | + :fish completion)) |
| 696 | + |
| 697 | +(defn print-completions [shell tree cmdline] |
| 698 | + (let [[_program-name & to-complete] (str/split (str/triml cmdline) #" +" -1) |
| 699 | + completions (complete-tree tree to-complete)] |
| 700 | + (doseq [completion completions] |
| 701 | + (println (format-completion shell {:completion completion}))))) |
| 702 | + |
| 703 | +;; dispatch |
595 | 704 |
|
596 | 705 | (defn- deep-merge [a b] |
597 | 706 | (reduce (fn [acc k] (update acc k (fn [v] |
|
656 | 765 | ([tree args] |
657 | 766 | (dispatch-tree tree args nil)) |
658 | 767 | ([tree args opts] |
659 | | - (let [{:as res :keys [cmd-info error available-commands]} |
660 | | - (dispatch-tree' tree args opts) |
661 | | - error-fn (or (:error-fn opts) |
662 | | - (fn [{:keys [msg] :as data}] |
663 | | - (throw (ex-info msg data))))] |
664 | | - (case error |
665 | | - (:no-match :input-exhausted) |
666 | | - (error-fn (merge |
667 | | - {:type :org.babashka/cli |
668 | | - :cause error |
669 | | - :all-commands available-commands} |
670 | | - (select-keys res [:wrong-input :opts :dispatch]))) |
671 | | - nil ((:fn cmd-info) (dissoc res :cmd-info)))))) |
| 768 | + (let [command-name (get-in opts [:completion :command]) |
| 769 | + [opt shell cmdline] args] |
| 770 | + (case opt |
| 771 | + "--babashka.cli/completion-snippet" |
| 772 | + (print-completion-shell-snippet (keyword shell) command-name) |
| 773 | + "--babashka.cli/complete" |
| 774 | + (print-completions (keyword shell) tree cmdline) |
| 775 | + (let [{:as res :keys [cmd-info error available-commands]} |
| 776 | + (dispatch-tree' tree args opts) |
| 777 | + error-fn (or (:error-fn opts) |
| 778 | + (fn [{:keys [msg] :as data}] |
| 779 | + (throw (ex-info msg data))))] |
| 780 | + (case error |
| 781 | + (:no-match :input-exhausted) |
| 782 | + (error-fn (merge |
| 783 | + {:type :org.babashka/cli |
| 784 | + :cause error |
| 785 | + :all-commands available-commands} |
| 786 | + (select-keys res [:wrong-input :opts :dispatch]))) |
| 787 | + nil ((:fn cmd-info) (dissoc res :cmd-info)))))))) |
672 | 788 |
|
673 | 789 | (defn dispatch |
674 | 790 | "Subcommand dispatcher. |
|
0 commit comments