Merge pull request #23 from hlship/hls/20241126-improved-help

Improvement to help

CHANGES.md

@@ -1,3 +1,10 @@
+# 0.14 -- UNRELEASED
+
+The `help` builtin command now includes an optional search term argument; if provided, only commands whose name
+or command summary includes the search term (using a caseless match) are included in the output.
+
+Added support for :command-ns meta-data on namespaces.
+
 # 0.13 -- 22 Sep 2024
 
 *BREAKING CHANGES*

README.md

@@ -352,21 +352,54 @@ overridden by setting the :command-category metadata on the namespace to a short
 
 Each category has a sort order, which defaults to 0.  The categories are sorted by this sort order,
 then (within each set of categories with the same sort order) by label.  The sort order
-can be specified as the :command-category-order metadata on the namespace.  `net.lewisship.cli-tools` has
+can be specified as the :command-category-order metadata on the namespace.  `net.lewisship.cli-tools.builtins` has
 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`.
 
+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
+
+Normally, there is a 1:1 mapping from namespace to category. In rare cases, you may want to have multiple namespaces
+map to the same category.
+
+A namespace may have a :command-ns meta-data, whose value is a symbol identifying another namespace.  The commands
+in the new namespace are categorized as if they were in the identified namespace.  Order counts: make sure the referenced
+namespace is listed before the referencing namespace.
+
+An example of this is the `net.lewisship.cli-tools.colors` namespace:
+
+```clojure
+
+(ns net.lewisship.cli-tools.colors
+  {:command-ns 'net.lewisship.cli-tools.builtins}
+  (:require [clj-commons.ansi :refer [pout]]
+            [clojure.string :as string]
+            [net.lewisship.cli-tools :refer [defcommand]]))
+
+(def ^:private width 16)
+
+(defcommand colors
+...
+```
+This adds an additional command to the built-in category, `colors`, as if it were declared in the `builtins` namespace.
+
+You can add this namespace to your own tools:
+
+![colors command](images/flow-colors.png)
+
 ## Command Groups
 
 A category can also have a `:command-group` metadata value, a short string that acts like a command name.
-All commands in the same namespace/category are accessible via that group command.  The built-in `help`
+All commands in the same namespace/category are only accessible via that group command.  The built-in `help`
 command will identify the command group when listing the commands in the category.
 
 Command groups are useful when creating the largest tools with the most commands; it allows for shorter command names,
-as the name only have to be unique within command group, not globally.
+as each commands' name will only have to be unique within it's command group, not globally.
 
 
 ## Testing

src/net/lewisship/cli_tools.clj

@@ -17,11 +17,9 @@
   (impl/exit status))
 
 (defn set-prevent-exit!
-  "Normally, after displaying a command summary, `System/exit` is called (with 0 if for --help,
-   or 1 if a validation error).
-
-   For testing purposes, this can be prevented; instead, an exception is thrown,
-   with message \"Exit\" and ex-data {:status <status>}."
+  "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,
+  used for testing, allow [[exit]] to throw an exception instead."
   [flag]
   (alter-var-root #'impl/prevent-exit (constantly flag)))
 
@@ -140,16 +138,29 @@
     ns-object
     (throw (RuntimeException. (format "namespace %s not found (it may need to be required)" (name ns-symbol))))))
 
-(defn- namespace->category
-  [ns-symbol]
-  (let [ns      (resolve-ns ns-symbol)
-        ns-meta (meta ns)]
-    {:category      ns-symbol
-     ;; :ns is removed before being written to cache
-     :ns            ns
-     :command-group (:command-group ns-meta)
-     :label         (:command-category ns-meta (name ns-symbol))
-     :order         (:command-category-order ns-meta 0)}))
+(defn- add-namespace-to-categories
+  [m ns-symbol]
+  (let [ns                (resolve-ns ns-symbol)
+        ns-meta           (meta ns)
+        ;; An existing namespace can be referenced with the :command-ns meta to make the subsequent namespace
+        ;; act as if it were part of the earlier namespace (same command-group, label, etc.).
+        {:keys [command-ns]} ns-meta
+        ;; Ok, looks like there's a difference between Babashka and Clojure. In Clojure, an unquoted symbol breaks
+        ;; (it looks like an unresolved classname) and a quoted symbol is a Symbol.  In Babashka, the quoted symbol
+        ;; ends up as the list (quote symbol).
+        k                 (if command-ns
+                            (if (sequential? command-ns)
+                              (second command-ns)
+                              command-ns)
+                            ns-symbol)
+        existing-category (get m k)]
+    (if existing-category
+      (assoc m ns-symbol existing-category)
+      (assoc m k
+             {:category      k
+              :command-group (:command-group ns-meta)
+              :label         (:command-category ns-meta (name ns-symbol))
+              :order         (:command-category-order ns-meta 0)}))))
 
 (defn locate-commands
   "Passed a seq of symbols identifying *loaded* namespaces, this function
@@ -159,20 +170,22 @@
 
   Returns a tuple: the command categories map, and the command map."
   [namespace-symbols]
-  (let [categories     (map namespace->category namespace-symbols)
+  (let [categories     (reduce add-namespace-to-categories {} namespace-symbols)
         ;; Each category that is a command group gets a psuedo command
         group-commands (->> categories
+                            vals
                             (filter :command-group)
                             (reduce (fn [m category-map]
                                       (let [{:keys [command-group]} category-map]
                                         ;; Currently, we only allow two levels of nesting: top level, and directly
                                         ;; within a group. This is the first place that would change if we allowed groups
                                         ;; within groups.
                                         (assoc m command-group {:command-path   [command-group]
-                                                                :group-category (dissoc category-map :ns)})))
+                                                                :group-category category-map})))
                                     {}))
-        f              (fn [m category-map]
-                         (let [{:keys [category command-group ns]} category-map
+        ;; In rare cases, multiple keys (ns'es) point to the same category map
+        f              (fn [m ns category-map]
+                         (let [{:keys [category command-group]} category-map
                                base-path (cond-> []
                                            command-group (conj command-group))]
                            (->> ns
@@ -208,8 +221,8 @@
                                                                       (impl/extract-command-summary v)
                                                                       :var          (symbol v)})))
                                         m))))
-        commands       (reduce f group-commands categories)
-        categories'    (map #(dissoc % :ns) categories)]
+        commands       (reduce-kv f group-commands categories)
+        categories'    (-> categories vals distinct)]
     [categories' commands]))
 
 (defn dispatch*
@@ -237,7 +250,7 @@
 
   All options are required.
 
-  Returns nil."
+  Returns nil (if it returns at all, as most command will ultimately invoke [[exit]])."
   [options]
   (impl/dispatch options))
 
@@ -305,7 +318,7 @@
   It also adds a `help` command from the net.lewisship.cli-tools namespace.
 
   If option and argument parsing is unsuccessful, then
-  a command usage summary is printed, along with errors, and the program exits
+  an error message is written to \\*err\\*, and the program exits
   with error code 1.
 
   dispatch simply loads and scans the namespaces (or obtains the necessary data from the

src/net/lewisship/cli_tools/builtins.clj

@@ -7,8 +7,12 @@
 
 (defcommand help
   "List available commands"
-  [flat ["-f" "--flat" "Ignore categories and show a simple list of commands"]]
+  [flat ["-f" "--flat" "Ignore categories and show a simple list of commands"]
+   :args
+   search-term ["SEARCH" "Filter shown commands to those that match this term"
+         :optional true]]
   ;; dispatch binds *options* for us
   (impl/show-tool-help (cond-> impl/*options*
-                               flat (assoc :flat true))))
+                               flat (assoc :flat true))
+                       search-term))
 

src/net/lewisship/cli_tools/colors.cljc

@@ -0,0 +1,50 @@
+(ns net.lewisship.cli-tools.colors
+  {:command-ns 'net.lewisship.cli-tools.builtins}
+  (:require [clj-commons.ansi :refer [pout]]
+            [clojure.string :as string]
+            [net.lewisship.cli-tools :refer [defcommand]]))
+
+(def ^:private width 16)
+
+(defcommand colors
+  "Shows available foreground and background colors."
+  []
+  (doseq [foreground [:black :bright-black
+                      :red :bright-red
+                      :green :bright-green
+                      :yellow :bright-yellow
+                      :blue :bright-blue
+                      :magenta :bright-magenta
+                      :cyan :bright-cyan
+                      :white :bright-white]]
+    (pout [{:width width
+            :pad   :both
+            :font  foreground}
+           (name foreground)]
+          (for [background [:black-bg
+                            :red-bg
+                            :green-bg
+                            :yellow-bg
+                            :blue-bg
+                            :magenta-bg
+                            :cyan-bg
+                            :white-bg]]
+            (list " "
+                  [{:width width
+                    :pad   :both
+                    :font  [foreground background]}
+                   (-> (name background) (string/replace "-bg" ""))])))
+    (pout [{:width width} " "]
+          (for [background [:bright-black-bg
+                            :bright-red-bg
+                            :bright-green-bg
+                            :bright-yellow-bg
+                            :bright-blue-bg
+                            :bright-magenta-bg
+                            :bright-cyan-bg
+                            :bright-white-bg]]
+            (list " "
+                  [{:width width
+                    :pad   :both
+                    :font  [foreground background]}
+                   (-> (name background) (string/replace "-bg" ""))])))))