Merge pull request #26 from hlship/hls/20250110-completions-25

Add support for zsh command completions

.github/workflows/clojure.yml

@@ -18,15 +18,15 @@ jobs:
         uses: actions/[email protected]
 
       - name: Setup Java
-        uses: actions/setup-java@v4.5.0
+        uses: actions/setup-java@v4.6.0
         with:
           java-version: '11'
           distribution: 'corretto'
 
       - name: Install clojure tools
-        uses: DeLaGuardo/setup-clojure@13.0
+        uses: DeLaGuardo/setup-clojure@13.1
         with:
-          cli: 1.12.0.1488
+          cli: 1.12.0.1495
 
       - name: Cache clojure dependencies
         uses: actions/cache@v4

CHANGES.md

@@ -1,3 +1,10 @@
+# 0.15 -- UNRELEASED
+
+Added optional namespace `net.lewisship.cli-tools.completions`, which is considered _experimental_.
+
+Added new functions to `net.lewisship.cli-tools`:
+- `abort` is used to terminate a tool with a status code and provide an error message to standard error
+
 # 0.14 -- 27 Nov 2024
 
 The `help` builtin command now includes an optional search term argument; if provided, only commands whose name

README.md

@@ -20,8 +20,20 @@ for you.
   will select the specific sub-command to execute. (think: `git`)
 - A complex tool organizes some commands into command groups that share an initial name (think `kubectl`)
 
+
 For tools with multiple commands, `cli-tools` automatically adds 
-a built-in `help` command to list out what commands are available.
+a built-in `help` command to list out what commands are available, and
+can even perform basic searches for commands.
+
+For complex tools, what `cli-tools` offers is **discoverability**.  You define the switches, options, and arguments for each command, and each command gets a `--help` switch to print
+out the command's summary. The  `help` command
+that can list out all the commands available, neatly organized, and can even do a simple
+search for you.  There's even (experimental) support for zsh completions for your tool and all of its categories, commands, and options.
+
+This kind of discoverability is a big improvement over shell aliases, and one-off shell scripts that leave you guessing what they do and what arguments need to be passed in.
+
+`cli-tools` also offers great **feedback**, using indentation, color, and careful attention
+to detail, to provide tool users with consistent, readable, and friendly error messages, command summaries, and so forth.
 
 `cli-tools` can work with Babashka, or with Clojure, but the near instantaneous startup time of Babashka is compelling
 for the kind of low-ceremony tools that `cli-tools` is intended for.
@@ -33,9 +45,8 @@ Below is an example of the author's personal toolkit, `flow`:
 
 ![Example](images/example-usage.png)
 
-Building on `cli-tools` provides discoverability and feedback, as the tool (and every command inside the tool) will provide detailed help.
-
-A more complete example is [dialog-tool](https://github.com/hlship/dialog-tool).
+A complete and open-source example is [dialog-tool](https://github.com/hlship/dialog-tool), which also shows how to organize 
+a tool so that it can be installed as a Homebrew formula.
 
 ## defcommand
 
@@ -297,6 +308,8 @@ and arguments definitions; the `:let` keyword is followed by a vector of binding
 In the expanded code, the bindings are moved to the top, before the option and argument
 definitions.  Further, if there are multiple `:let` blocks, they are concatinated.
 
+This also means that the bindings _can not_ reference the symbols for options or arguments.
+
 ### :validate \<vector of test/message pairs\>
 
 Often you will need to perform validations that consider multiple fields.
@@ -357,9 +370,9 @@ a sort order of 100, so that it will generally be last.
 
 If you want to see the list of commands without categories, use the `-f` / `--flat` option to `help`.
 If you want to use multiple namespaces for your commands without using categories,
-add the `:flat` option to the map passed to `dispatch`.
+add `:flat true` to the options map passed to `dispatch`.
 
-The help command itself accept a single search term; it will filter the commands and categories it outputs to only
+The `help` command itself accept a single search term; it will filter the commands and categories it outputs to only
 those that contain the search term in either the command name, or command summary. This search is caseless.
 
 ## :command-ns meta-data
@@ -401,6 +414,21 @@ command will identify the command group when listing the commands in the categor
 Command groups are useful when creating the largest tools with the most commands; it allows for shorter command names,
 as each commands' name will only have to be unique within it's command group, not globally.
 
+## Utilities
+
+### abort
+
+The `net.lewisship.cli-tools/abort` function provides a uniform way to indicate a failure
+and terminate execution.
+
+`abort` can be invoked from inside a command, and will output (to standard error)
+the tool name and command name in bold red, and the provided messages
+in red.
+
+Messages may also be exceptions, from which the exception message is extracted (exceptions with a null message
+are converted to the exception class name).
+
+Finally, `abort` invokes `exit` with the provided exit status code.
 
 ## Testing
 
@@ -413,8 +441,9 @@ The map must provide a keyword key for each option or positional argument; the k
 even for options that normally have a default value. All normal option or argument validation is skipped.
 
 You may need to mock out `net.lewisship.cli-tools/print-errors` if your command
-invokes it, as that relies on some additional non-documented keys to
-be present in the command map. Fortunately, it is quite rare for a command to need to invoke this function.
+invokes it, as that relies on some internal state from undocumented dynamicall-bound vars. 
+
+Fortunately, it is quite rare for a command to need to invoke this function.
 
 When _not_ bypassing parsing and validation (that is, when testing by passing strings to the command function), 
 validation errors normally print a command summary and then call `net.lewisship.cli-tools/exit`, which in turn, invokes `System/exit`; this is obviously 
@@ -433,10 +462,10 @@ and collect meta-data from all the namespaces and command functions.  Thanks to
 but is made faster using caching.
 
 `dispatch` builds a cache based on the options passed to it, and the contents of the classpath; it can then 
-load the data it needs to operate from the cache if present.
+load the data it needs to operate from the cache, if such data is present.
 
-When executing from the cache, `dispatch` will ultimately load only a single command namespace, to invoke the single
-function.  This allows a complex tool, one with potentially hundreds of commands, to still execute the body
+When executing from the cache, `dispatch` will ultimately load only a single command namespace,
+to invoke the single command function.  This allows a complex tool, one with potentially hundreds of commands, to still execute the body
 of the `defcommand` within milliseconds.
 
 This may have an even more significant impact for a tool that is built on top of Clojure, rather than Babashka.
@@ -497,6 +526,17 @@ This is built on the `tput` command line tool, so it works on OS X and Linux, bu
 
 The above `job-status-demo`, like `colors`, can be added by including the `net.lewisship.cli-tools.job-status-demo` namespace.
 
+## zsh completions (experimental)
+
+The namespace `net.lewisship.cli-tools.completions` adds a `completions` command.  This command will
+compose a zsh completion script, which can be installed to a directory on the $fpath such as
+`/usr/local/share/zsh/site-functions`.
+
+![zsh completions demo](images/cli-tools-zsh-completion.gif)
+
+zsh completions greatly enhance the discoverability of commands, categories, and command options within a tool.
+However, this functionality is considered _experimental_ due to the complexity of zsh completion scripts.
+
 
 ## License
 

deps.edn

@@ -1,9 +1,10 @@
-{:paths ["src"]
+{:paths ["src"
+         "resources"]
  ;; Needed to build and test w/ clojure
  :deps  {org.clojure/clojure      {:mvn/version "1.12.0"}
          org.clojure/tools.cli    {:mvn/version "1.1.230"}
          babashka/process         {:mvn/version "0.5.22"}
-         org.clj-commons/pretty   {:mvn/version "3.2.0"}
+         org.clj-commons/pretty   {:mvn/version "3.3.0"}
          org.clj-commons/humanize {:mvn/version "1.1"}}
 
  :net.lewisship.build/scm
@@ -19,7 +20,7 @@
                                                        :git/sha "dfb30dd"}
                  io.github.tonsky/clj-reload {:mvn/version "0.7.1"}
                  nubank/matcher-combinators {:mvn/version "3.9.1"}
-                 babashka/babashka {:mvn/version "1.12.195"}}
+                 babashka/babashka {:mvn/version "1.12.196"}}
    :exec-fn     cognitect.test-runner.api/test
    :jvm-opts    ["-Dclj-commons.ansi.enabled=true"]
    :exec-args

resources/net/lewisship/cli_tools/category.tpl

@@ -0,0 +1,21 @@
+{{category.fn-name}}() {
+  local state line
+
+  _arguments -C \
+      "1: :->cmds" \
+      "*::arg:->args"
+
+  case "$state" in
+     cmds)
+       _values "{{tool}} {{category.name}} subcommands" {% for sub in category.subs %} \
+         "{{sub.name}}[{{sub.summary}}]" {% endfor %}
+       ;;
+     args)
+       case $line[1] in {% for sub in category.subs %}
+         {{sub.name}}) {{sub.fn-name}} ;; {% endfor %}
+       esac
+       ;;
+  esac
+}
+
+

resources/net/lewisship/cli_tools/command.tpl

@@ -0,0 +1,5 @@
+{{command.fn-name}}() {
+    _arguments -s {% for opt in command.options %} \
+      {{ opt }} {% endfor %}
+}
+

resources/net/lewisship/cli_tools/top-level.tpl

@@ -0,0 +1,22 @@
+#compdef _{{tool}} {{tool}}
+
+_{{tool}}() {
+  local line state
+
+  _arguments -C \
+    "1: :->cmds" \
+    "*::arg:->args"
+
+   case "$state" in
+     cmds)
+        _values "{{tool}} command" {% for cmd in commands %} \
+            "{{cmd.name}}[{{cmd.summary}}]" {% endfor %}
+        ;;
+     args)
+       case $line[1] in {% for cmd in commands %}
+         {{cmd.name}}) {{cmd.fn-name}} ;;
+{% endfor %}
+       esac
+       ;;
+   esac
+}

scale-test/scale_test.clj

@@ -1,6 +1,7 @@
 (ns scale-test
   (:require [clojure.string :as str]
             [babashka.fs :as fs]
+            selmer.util
             [selmer.parser :as selmer]))
 
 (def root-dir "scale-test/uber")
@@ -9,6 +10,10 @@
   (str/split "gnip frob update nerd spit snip echo gnop cluster system node module user role acl server service deployment"
              #"\s+"))
 
+(def category-name-terms
+  (str/split "kubenetes operations database polylith charts splunk aws datomic clojure monitor github console"
+             #"\s+"))
+
 (defn gen-single-command-name
   []
   (let [terms (repeatedly 3 #(rand-nth command-name-terms))]
@@ -28,18 +33,21 @@
 
 (defn write-ns
   [group? i command-names]
-  (let [ns-name (str "commands.command-ns-" i)
+  (let [category-name (str (rand-nth category-name-terms) "-" i)
+        ns-name (str "commands." category-name)
         ns-file (-> ns-name
                     (str/replace "-" "_")
-                    (str/replace "." "/")
-                    )]
+                    (str/replace "." "/"))]
     (render "command-ns.edn"
             (str "src/" ns-file ".clj")
             {:ns            ns-name
              :command-names command-names
-             :category      (str "Category " i)
+             :category      (-> category-name
+                                str/capitalize
+                                (str/replace #"-" " ")
+                                (str " Commands"))
              :group         (when group?
-                              (str "command-" i))})
+                              category-name)})
     ns-name))
 
 (defn setup
@@ -50,18 +58,19 @@
   (fs/delete-tree root-dir)
   (fs/create-dirs (str root-dir "/src/commands"))
   (fs/create-dirs (str root-dir "/src/uber"))
-  (let [{:keys [commands namespaces group]
-         :or   {commands   6
-                namespaces 250
-                group      true}} opts
-        commands-per-ns (->> command-names
-                             (partition commands)
-                             (take namespaces))
-        ns-names        (doall (map-indexed (partial write-ns group) commands-per-ns))]
-    (render "bb.edn" "bb.edn" {})
-    (render "deps.edn" "deps.edn" {})
-    (render "app.edn" "app" {:ns-names ns-names})
-    (render "main.edn" "src/uber/main.clj" {:ns-names ns-names})
-    (fs/set-posix-file-permissions (str root-dir "/app") "rwxrwxrwx")
-    (printf "%,d namespaces, %,d commands/namespace, %,d total command%n"
-            namespaces commands (* namespaces commands))))
+  (selmer.util/without-escaping
+    (let [{:keys [commands namespaces group]
+           :or   {commands   6
+                  namespaces 250
+                  group      true}} opts
+          commands-per-ns (->> command-names
+                               (partition commands)
+                               (take namespaces))
+          ns-names        (doall (map-indexed (partial write-ns group) commands-per-ns))]
+      (render "bb.edn" "bb.edn" {})
+      (render "deps.edn" "deps.edn" {})
+      (render "app.edn" "app" {:ns-names ns-names})
+      (render "main.edn" "src/uber/main.clj" {:ns-names ns-names})
+      (fs/set-posix-file-permissions (str root-dir "/app") "rwxrwxrwx")
+      (printf "%,d namespaces, %,d commands/namespace, %,d total commands%n"
+              namespaces commands (* namespaces commands)))))

scale-test/templates/app.edn

@@ -2,4 +2,4 @@
 
 (require '[net.lewisship.cli-tools :as cli])
 
-(cli/dispatch {:namespaces '[{{ns-names|join:" "}}]})
+(cli/dispatch {:namespaces '[{{ns-names|join:" "}} net.lewisship.cli-tools.completions]})

src/net/lewisship/cli_tools.clj

@@ -16,6 +16,36 @@
   [status]
   (impl/exit status))
 
+(defn abort
+  "Invoked when a tool has a runtime failure. Writes to standard error;
+  identifies the tool name, category (if any) and command name
+  (in bold red) and then writes the remaining message text after a colon and a space,
+  in red.
+
+  Each element of message may either be a composed string, or an exception.
+
+  Each exception in the message is converted to a string via `ex-message`.
+  If `ex-message` returns nil, then the class name of the exception is used."
+  {:added "0.15"}
+  [status & message]
+  (let [{:keys [tool-name]} impl/*options*
+        {:keys [command-path]} impl/*command*]
+    (ansi/perr
+      [:red
+       [:bold
+        tool-name
+        (when command-path
+          (list " " (str/join " " command-path)))
+        ":"]
+       " "
+       (map (fn [m]
+              (if (instance? Throwable m)
+                (or (ex-message m)
+                    (-> m class .getName))
+                m))
+            message)])
+    (exit status)))
+
 (defn set-prevent-exit!
   "cli-tools will call [[exit]] when help is requested (with a 0 exit status, or 1 for
   a input validation error).  Normally, that results in a call to System/exit, but this function,
@@ -85,7 +115,7 @@
 
    The returned function is variadic, accepting a number of strings, much
    like a `-main` function. For testing purposes, it may instead be passed a single map,
-   a map of options, which bypasses parsing and validation of the arguments, and is used only for testing.
+   a map of options, which bypasses parsing and validation of the arguments.
 
    Finally, the body is evaluated inside a let that destructures the options and positional arguments into local symbols."
   [command-name docstring interface & body]
@@ -122,15 +152,25 @@
              ;; args# is normally a seq of strings, from *command-line-arguments*, but for testing,
              ;; it can also be a map with key :options
              test-mode?# (impl/command-map? args#)
-             ~command-map-symbol (if test-mode?#
-                                   {:options (first args#)}
-                                   (impl/parse-cli ~command-name'
-                                                   args#
-                                                   ~(select-keys parsed-interface parse-cli-keys)))
-             ~@let-option-symbols]
-         (when-not test-mode?#
-           ~validations)
-         ~@body))))
+             command-spec# ~(select-keys parsed-interface parse-cli-keys)]
+         (if impl/*introspection-mode*
+           command-spec#
+           (let [~command-map-symbol (cond
+                                       test-mode?#
+                                       {:options (first args#)}
+
+                                       impl/*introspection-mode*
+                                       command-spec#
+
+                                       :else
+                                       (impl/parse-cli ~command-name'
+                                                       args#
+                                                       command-spec#))
+                 ;; These symbols de-reference the command-map returned from parse-cli.
+                 ~@let-option-symbols]
+             (when-not test-mode?#
+               ~validations)
+             ~@body))))))
 
 (defn- resolve-ns
   [ns-symbol]