Merge pull request #36 from hlship/hls/20250813-tool-handler

Support custom tool handlers (for tool-level options)

Author: hlship

CHANGES.md

@@ -5,13 +5,16 @@
 * Groups are now defined in the options passed to `net.lewisship.cli-tools/dispatch`, not in
   namespace metadata
 * Command names are matched as prefixes (not substrings)
-* The tool's documentation must now be specified in top-level :doc option key.
+* The tool's documentation must now be specified in top-level :doc option key (not from namespace meta-data)
 * `net.lewisship.cli-tools`:
-    * In a `defcommand`, the :summary key has been renamed to :title
+    * In a `defcommand`:
+        * The :summary key has been renamed to :title
+        * The :as keyword is no longer supported
     * `abort` has been stripped down, it no longer writes the tool name, command path, etc.
-    * `defcommand`: the :as keyword is not longer supported.
-    * The two-arg variant of `print-errors` has been removed.
-    * 
+    * The two-arg variant of `print-errors` has been removed
+    * `dispatch*` function arguments have changed
+    * `expand-dispatch-options` has been removed
+  
 *Changes*
 
 * Groups may now be nested, to arbitrary depth
@@ -20,6 +23,8 @@
 * Tool help now displays just top-level commands by default (add --full to list nested commands)
 * net.lewisship.cli-tools
     * New `command-path` function returns a composed string of the tool name and command path
+    * `dispatch` function has new options:
+        * :handler is a function to handle top-level tool options (then delegate to `dispatch*`)
 
 # 0.15.1 -- 27 Jan 2025
 

src/net/lewisship/cli_tools.clj

@@ -4,6 +4,7 @@
             [clj-commons.ansi :as ansi]
             [clojure.string :as string]
             [net.lewisship.cli-tools.impl :as impl :refer [cond-let]]
+            [clojure.tools.cli :as cli]
             [net.lewisship.cli-tools.cache :as cache]))
 
 (defn exit
@@ -162,60 +163,124 @@
                ~validations)
              ~@body))))))
 
-;; TODO: Expandable expansion and caching
 
-(defn dispatch*
-  "Invoked by [[dispatch]] after namespace and command resolution."
-  [expanded-options]
-  (impl/dispatch expanded-options))
-
-(defn expand-dispatch-options
-  "Called by [[dispatch]] to expand the options before calling [[dispatch*]].
-  Some applications may call this instead of `dispatch`, modify the results, and then
-  invoke `dispatch*`."
+(def ^{:added "0.16.0"}
+  default-tool-options
+  "Default tool command line options."
+  [["-C" "--color" "Enable ANSI color output"]
+   ["-N" "--no-color" "Disable ANSI color output"]
+   ["-h" "--help" "This tool summary"]])
+
+(defn- expand-tool-options
+  "Expanded dispatch options into tool options, leveraging a cache."
   [options]
-  (let [{:keys [cache-dir arguments]} options
-        options' (select-keys options [:tool-name
-                                       :doc
-                                       :namespaces
-                                       :groups])
-        result   (if-not cache-dir
-                   (impl/expand-dispatch-options options')
-                   (let [cache-dir' (fs/expand-home cache-dir)
-                         digest     (cache/classpath-digest options')
-                         cached     (cache/read-from-cache cache-dir' digest)]
-                     (if cached
-                       cached
-                       (let [full (impl/expand-dispatch-options options')]
-                         (cache/write-to-cache cache-dir' digest full)
-                         full))))]
-    (assoc result :arguments (or arguments *command-line-args*))))
-
-(def ^:private default-options
+  (let [{:keys [cache-dir]} options
+        options'   (select-keys options [:tool-name
+                                         :doc
+                                         :namespaces
+                                         :groups])
+        cache-dir' (when cache-dir
+                     (fs/expand-home cache-dir))
+        digest     (when cache-dir'
+                     (cache/classpath-digest options'))
+        cached     (when digest
+                     (cache/read-from-cache cache-dir' digest))
+        result     (if cached
+                     cached
+                     (let [expanded (impl/expand-tool-options options')]
+                       (when cache-dir'
+                         (cache/write-to-cache cache-dir' digest expanded))
+                       expanded))]
+    (merge result
+           (select-keys options [:tool-name :doc :arguments :tool-summary]))))
+
+(defn dispatch*
+  "Called from a tool handler to process remaining command line arguments.
+
+  - dispatch-options - modified dispatch options
+  - color-flag - if non-nil, enables or disables ANSI colors before dispatching
+  - help - if true, then change the arguments to \"help\", to print tool help
+
+  In the dispatch options map, the tool handler should have set the following:
+
+  - :arguments -- seq of remaining arguments after processing tool-level options
+  - :tool-summary -- summary of tool options (used when printing tool help)."
+  [dispatch-options color-flag help?]
+  (cond
+    (some? color-flag)
+    (binding [ansi/*color-enabled* color-flag]
+      (dispatch* dispatch-options nil help?))
+
+    help?
+    (recur (assoc dispatch-options :arguments ["help"]) nil false)
+
+    :else
+    (-> dispatch-options expand-tool-options impl/dispatch)))
+
+(defn summarize-specs
+  "Converts a tools.cli command specification to a description of the options; this is an enhanced version of
+  clojure.tools.cli/summarize that makes use of indentation and ANSI colors.
+
+  Returns a delay (to ensure that ANSI color enabled/disabled options are enforced)."
+  {:added "0.16.0"}
+  [specs]
+  ;; summarize-specs is called before we parse the command line options (-C, -N) that may enable/disable
+  ;; ANSI colors, so a delay is used to prevent premature evaluation.
+  (delay (impl/summarize-specs specs)))
+
+(defn default-tool-handler
+  "Default tool handler, passed the tool options.  The [[default-tool-options]] support enabling or disabling
+  ANSI fonts, and requesting top-level help.
+
+  This is the default for the :handler key of dispatch options.
+
+  This function is passed the dispatch options, parses the default tool options, and delegates the rest to [[dispatch*]]."
+  {:added "0.16.0"}
+  [dispatch-options]
+  (let [{:keys [options arguments summary errors]
+         :as   result} (cli/parse-opts (:arguments dispatch-options)
+                                       default-tool-options
+                                       :in-order true
+                                       :summary-fn summarize-specs)
+        {:keys [color no-color help]} options
+        color-flag (cond color true
+                         no-color false)]
+    (when errors
+      (throw (ex-info "Tool parse sanity check" result)))
+
+    (dispatch* (-> dispatch-options
+                   (assoc :arguments arguments
+                          :tool-summary summary))
+               color-flag help)))
+
+(def ^:private default-dispatch-options
   {:cache-dir (or (System/getenv "CLI_TOOLS_CACHE_DIR")
-                  "~/.cli-tools-cache")})
+                  "~/.cli-tools-cache")
+   :handler   default-tool-handler})
 
 (defn dispatch
   "Locates commands in namespaces, finds the current command
   (as identified by the first command line argument) and processes CLI options and arguments.
 
-  options:
+  dispatch-options:
   
   - :tool-name (optional, string) - used in command summary and errors
   - :doc (optional, string) - used in help summary
   - :arguments - command line arguments to parse (defaults to `*command-line-args*`)
   - :namespaces - seq of symbols identifying namespaces to search for root-level commands
   - :groups - map of group command (a string) to a group map
+  - :handler - function to handle tool-level options, defaults to [[default-tool-handler]]
+  - :cache-dir (optional, string) - directory to cache data in, or nil to disable cache
 
   The :tool-name option is only semi-optional; in a Babashka script, it will default
   from the `babashka.file` system property, if any. An exception is thrown if :tool-name
   is not provided and can't be defaulted.
 
   A group map defines a set of commands grouped under a common name.  Its structure:
 
-  - :doc - string, a short string identifying the purpose of the group
-  - :namespaces - seq of symbols identifying namespaces of commands in the group
-  - :groups - recusive map of groups nested within the group
+  - :doc (optional, string) - a short string identifying the purpose of the group
+  - :namespaces (seq of symbols, required) - identifies namespaces providing commands in the group
+  - :groups (optional, map) - recusive map of groups nested within the group
 
   dispatch will always add the `net.lewiship.cli-tools.builtins` namespace to the root
   namespace list; this ensures the built-in `help` command is available.
@@ -226,13 +291,16 @@
 
   Caching is enabled by default; this means that a scan of all namespaces is only required on the first
   execution; subsequently, only the single namespace implementing the selected command will need to
-  be loaded.
+  be loaded.  :cache-dir defaults to the value of the CLI_TOOLS_CACHE_DIR environment variable, or
+  to the default value `~/.cli-tools-cache`.  If set to nil, then caching is disabled.
 
   Returns nil."
-  [options]
-  (-> (merge default-options options)
-      expand-dispatch-options
-      dispatch*))
+  [dispatch-options]
+  (let [options' (merge {:arguments *command-line-args*}
+                        default-dispatch-options
+                        dispatch-options)
+        {:keys [handler]} options']
+    (handler (dissoc options' :handler))))
 
 (defn select-option
   "Builds a standard option spec for selecting from a list of possible values.

src/net/lewisship/cli_tools/builtins.clj

@@ -12,5 +12,5 @@
    search-term ["SEARCH" "Filter shown commands to those that match this term"
          :optional true]]
   ;; dispatch binds *options* for us
-  (impl/print-tool-help impl/*options* search-term full?))
+  (impl/print-tool-help impl/*tool-options* search-term full?))
 

src/net/lewisship/cli_tools/completions.clj

@@ -101,7 +101,7 @@
    output-path ["PATH" "File to write completions to."
                 :optional true]]
   (binding [impl/*introspection-mode* true]
-    (let [{:keys [command-root tool-name groups]} impl/*options*]
+    (let [{:keys [command-root tool-name groups]} impl/*tool-options*]
       (if output-path
         (do
           (with-open [w (-> output-path