Merge pull request #38 from hlship/hls/20280515-messy

Handle messy groups (groups that are also commands)

Author: hlship

CHANGES.md

@@ -24,12 +24,14 @@
 * Tool help output has been reordered, with top-level tool commands first (previously, those were in a "Builtin" group and listed last)
 * Tool help now displays just top-level commands by default (add --full to list nested commands)
 * When extracting the first sentence as the single-line index, embedded period are no longer considered the end of the sentence
-* net.lewisship.cli-tools
+* `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*`)
         * :transformer provides a function to add additional commands and groups after namespaces are loaded
         * :source-dirs specifies extra directories to consider when caching
+        * Can handle "messy" case where a command has the same name as a group
+* Cache files are now stored in `~/.cache/net.lewisship.cli-tools` by default
 
 # 0.15.1 -- 27 Jan 2025
 

doc/caching.md

@@ -18,8 +18,9 @@ Our mockup of 1500 commands across 250 namespaces executes twice as fast using t
 
 Babashka is amazingly fast for these purposes; the same test executes in 0.23 seconds.
 
-By default, `dispatch` will store its cache in the `~/.cli-tools-cache` directory; the environment variable
-`CLI_TOOLS_CACHE_DIR` can override this default. 
+By default, `dispatch` will store its cache in the `~/.cache/net.lewisship.cli-tools` directory; the environment variable
+`CLI_TOOLS_CACHE_DIR` can override this default. (The `~/.cache` part is via
+`babaska.fs/xdg-cache-home`). 
 
-Alternately, you can also specify a path as the :cache-dir option.
+Alternately, you can also specify a java.nio.file.Path instance as the :cache-dir option.
 

src/net/lewisship/cli_tools.clj

@@ -256,8 +256,9 @@
                color-flag help)))
 
 (def ^:private default-dispatch-options
-  {:cache-dir (or (System/getenv "CLI_TOOLS_CACHE_DIR")
-                  "~/.cli-tools-cache")
+  {:cache-dir (or (some-> (System/getenv "CLI_TOOLS_CACHE_DIR")
+                          fs/expand-home)
+                  (fs/xdg-cache-home "net.lewisship.cli-tools"))
    :handler   default-tool-handler})
 
 (defn dispatch

src/net/lewisship/cli_tools/cache.cljc

@@ -90,7 +90,7 @@
 (defn write-to-cache
   [cache-root digest cache-data]
   (let [_ (when-not (fs/exists? cache-root)
-            (fs/create-dir cache-root))
+            (fs/create-dirs cache-root))
         f (fs/file cache-root (str digest ".edn"))]
     (spit f (pr-str cache-data))))
 

src/net/lewisship/cli_tools/impl.clj

@@ -686,8 +686,9 @@
 
 (defn- command-match?
   [command search-term]
-  (let [{:keys [doc title command-path]} command]
+  (let [{:keys [doc group-doc title command-path]} command]
     (or (string-matches? doc search-term)
+        (string-matches? group-doc search-term)
         (string-matches? title search-term)
         (some #(string-matches? % search-term) command-path))))
 
@@ -709,11 +710,13 @@
   [command-map]
   (or (:title command-map)
       (-> command-map :doc first-sentence)
-      (when-not (:fn command-map)
+      (-> command-map :group-doc first-sentence)
+      (when (-> command-map :subs seq)
         (let [{command-count true
                group-count   false} (->> command-map
                                          :subs
                                          vals
+                                         ;; Not quite accurate if messy (command and group at same time)
                                          (map #(-> % :fn some?))
                                          frequencies)]
           [:faint
@@ -743,7 +746,7 @@
       (pout (when recurse? "\n")
             [:bold (string/join " " (:command-path container-map))]
             " - "
-            (or (some-> container-map :doc cleanup-docstring)
+            (or (some-> container-map :group-doc cleanup-docstring)
                 missing-doc)))
 
     (when (seq sorted-commands)
@@ -761,7 +764,7 @@
     ;; Recurse and print sub-groups
     (when recurse?
       (->> sorted-commands
-           (remove :fn)                                     ; Remove commands, leave groups
+           (filter #(-> % :subs seq))                       ; Remove commands, leave groups and messy command/groups
            (run! #(print-commands command-name-width' % (:subs %) true))))))
 
 (defn- command-path-width
@@ -840,18 +843,60 @@
   [tool-name]
   (list ", use " [:bold.green tool-name " help"] " to list commands"))
 
+(defn- no-command
+  [tool-name]
+  (abort [:bold.green tool-name] ": no command provided" (use-help-message tool-name)))
+
+(defn- incomplete
+  [tool-name command-path matchable-terms]
+  (abort
+    [:bold.green tool-name ": "
+     (string/join " " (butlast command-path))
+     [:red (last command-path)]]
+    " is incomplete; "
+    (compose-list matchable-terms)
+    " could follow; use "
+    [:bold [:green tool-name " " (string/join " " command-path) " --help (or -h)"]]
+    " to list commands"))
+
+(defn- no-match
+  [tool-name command-path term matched-terms matchable-terms]
+  (let [body        (if (-> matched-terms count pos?)
+                      (list "could match "
+                            (compose-list matched-terms {:conjuction "or"}))
+                      (list "is not a command, expected "
+                            (compose-list matchable-terms {:conjuction "or"})))
+        help-suffix (list
+                      "; use "
+                      [:bold [:green tool-name " "
+                              (if (seq command-path)
+                                (string/join " " command-path)
+                                "help")]]
+                      (when (seq command-path)
+                        " --help (or -h)")
+                      " to list commands")]
+    (abort
+      [:bold [:green tool-name] ": "
+       [:green (string/join " " command-path)]
+       (when (seq command-path) " ")
+       [:red term]]
+      " "
+      body
+      help-suffix)))
+
 (defn dispatch
   [{:keys [command-root arguments tool-name] :as options}]
   (binding [*tool-options* options]
     (let [command-name (first arguments)]
       (if (or (nil? command-name)
               (string/starts-with? command-name "-"))
-        (abort [:bold.green tool-name] ": no command provided" (use-help-message tool-name))
-        (loop [prefix            []                           ; Needed?
-               term              command-name
-               remaining-args    (next arguments)
-               container-map     nil
-               commands-map      command-root]
+        (no-command tool-name)
+        (loop [command-path           []
+               term                   command-name
+               remaining-args         (next arguments)
+               container-map          nil
+               commands-map           command-root
+               invoke-last-command-fn nil]
           (cond-let
             (#{"-h" "--help"} term)
             (do
@@ -864,58 +909,48 @@
             ;; Options start with a '-', but we're still looking for commands
             (or (nil? term)
                 (string/starts-with? term "-"))
-            (abort
-              [:bold.green tool-name ": "
-               (string/join " " (butlast prefix))
-               [:red (last prefix)]]
-              " is incomplete; "
-              (compose-list matchable-terms)
-              " could follow; use "
-              [:bold [:green tool-name " " (string/join " " prefix) " --help (or -h)"]]
-              " to list commands")
+            ;; In messy mode, this lets us backtrack to the containing command (which is also a group, that's
+            ;; why we call it messy) and invoke it as a command now that know the next term doesn't indentify
+            ;; another command or group.
+            (if invoke-last-command-fn
+              (invoke-last-command-fn)
+              (incomplete tool-name command-path matchable-terms))
 
             :let [matched-terms (find-matches term matchable-terms)
                   match-count (count matched-terms)]
 
             (not= 1 match-count)
-            (let [body        (if (pos? match-count)
-                                (list "could match "
-                                      (compose-list matched-terms {:conjuction "or"}))
-                                (list "is not a command, expected "
-                                      (compose-list matchable-terms {:conjuction "or"})))
-                  help-suffix (list
-                                "; use "
-                                [:bold [:green tool-name " "
-                                        (if (seq prefix)
-                                          (string/join " " prefix)
-                                          "help")]]
-                                (when (seq prefix)
-                                  " --help (or -h)")
-                                " to list commands")]
-              (abort
-                [:bold [:green tool-name] ": "
-                 [:green (string/join " " prefix)]
-                 (when (seq prefix) " ")
-                 [:red term]]
-                " "
-                body
-                help-suffix))
+            ;; Likewise, if the next term doesn't look like an option, but doesn't match a nested command or group
+            ;; then it must be a positional argument to the container command (that's also a messy group).
+            (if invoke-last-command-fn
+              (invoke-last-command-fn)
+              (no-match tool-name command-path term matched-terms matchable-terms))
 
             ;; Exactly one match
             :let [matched-term (first matched-terms)
                   matched-command (get possible-commands matched-term)]
 
             (:fn matched-command)
-            (binding [*command-map* matched-command]
-              (apply (-> matched-command :fn requiring-resolve) remaining-args))
+            (let [invoke-command #(binding [*command-map* matched-command]
+                                    (apply (-> matched-command :fn requiring-resolve) remaining-args))]
+              ;; It's a command, but has :subs, so it's also a group (this is the "messy" scenario)
+              (if (-> matched-command :subs seq)
+                (recur (:command-path matched-command)
+                       (first remaining-args)
+                       (rest remaining-args)
+                       matched-command
+                       (:subs matched-command)
+                       invoke-command)
+                (invoke-command)))
 
             ;; Otherwise, it was a command group.
             :else
             (recur (:command-path matched-command)
                    (first remaining-args)
                    (rest remaining-args)
                    matched-command
-                   (:subs matched-command)))))))
+                   (:subs matched-command)
+                   invoke-last-command-fn))))))
   nil)
 
 (defn command-map?
@@ -951,7 +986,7 @@
                                            {:fn           (symbol command-var)
                                             ;; Commands have a full :doc and an optional short :title
                                             ;; (the title defaults to the first sentence of the :doc
-                                            ;; if not provided
+                                            ;; if not provided)
                                             :doc          doc
                                             :command      command-name
                                             :command-path (conj path command-name)}
@@ -971,16 +1006,18 @@
         ;; Mix in nested groups to form the subs for this group
         subs            (reduce-kv
                           (fn [commands group-command group-descriptor]
-                            (assoc commands group-command
+                            (update commands group-command merge
                                    (build-command-group group-descriptor path' group-command)))
                           direct-commands
                           groups)
         doc'            (or doc
                             (some #(-> % find-ns meta :doc) namespaces))]
-    {:doc          doc'                                     ; groups have just :doc, no :title
-     :command      command
-     :command-path path'
-     :subs         subs}))
+    (cond-> {
+             :command      command
+             :command-path path'
+             :subs         subs}
+      ; groups have just :group-doc, no :title
+      doc' (assoc :group-doc doc'))))
 
 (defn expand-tool-options
   [dispatch-options]

src/net/lewisship/cli_tools/specs.clj

@@ -1,7 +1,8 @@
 (ns net.lewisship.cli-tools.specs
   (:require [clojure.spec.alpha :as s]
             [clojure.string :as str]
-            [net.lewisship.cli-tools :as cli-tools]))
+            [net.lewisship.cli-tools :as cli-tools])
+  (:import (java.nio.file Path)))
 
 (s/def ::dispatch-options (s/keys :req-un [::namespaces]
                                   :opt-un [::tool-name
@@ -28,7 +29,7 @@
 (s/def ::group (s/keys :req-un [::namespaces]
                        :opt-un [::doc ::groups]))
 
-(s/def ::cache-dir (s/nilable string?))
+(s/def ::cache-dir (s/nilable #(instance? Path %)))
 
 (s/def ::transformer fn?)
 

test-resources/messy-full-help.txt

@@ -0,0 +1,16 @@
+Usage: bigmess [OPTIONS] COMMAND ...
+
+Options:
+  -C, --color    Enable ANSI color output
+  -N, --no-color Disable ANSI color output
+  -h, --help     This tool summary
+
+Commands:
+    help: List available commands
+   messy: Messy command
+  simple: Simple command
+
+messy - Messy command and group at same time
+
+Commands:
+  nested: Command nested under messy group/command

test/net/lewisship/cli_tools/messy_test.clj

@@ -0,0 +1,63 @@
+(ns net.lewisship.cli-tools.messy-test
+  (:require [clj-commons.ansi :as ansi]
+            [clojure.string :as string]
+            [net.lewisship.cli-tools :as cli]
+            [net.lewisship.cli-tools.aux :refer [capture-result]]
+            [clojure.test :refer [deftest is]]))
+
+(cli/set-prevent-exit! true)
+
+(defn- dispatch [& args]
+  (binding [ansi/*color-enabled* false]
+    (capture-result
+      (cli/dispatch {:tool-name  "bigmess"
+                     :namespaces '[net.lewisship.messy-commands]
+                     :groups     {"messy" {:namespaces '[net.lewisship.messy]
+                                           :doc "Messy command and group at same time"}}
+                     :arguments  args
+                     :cache-dir  nil
+                     :messy?     true}))))
+
+(deftest full-help
+  (is (match? {:status 0
+               :out    (slurp "test-resources/messy-full-help.txt")}
+              (dispatch "help" "--full"))))
+
+(deftest simple-commands-work
+  (is (match? {:status 0
+               :out    "simple: ok\n"}
+              (dispatch "simp"))))
+
+(deftest missing-positional-in-nested
+  (is (match? {:status 1
+               :err    "Error in bigmess messy: No value for required argument NAME\n"}
+              (dispatch "messy"))))
+
+(deftest commands-nested-inside-commands
+  (is (match? {:out "nested: ok\n"}
+              (dispatch "mess" "nest"))))
+
+(deftest matches-command-when-cant-find-sub-command
+  (is (match? {:out "messy: kiwi ok\n"}
+              (dispatch "mess" "kiwi"))))
+
+(comment
+
+ (defn capture [f & args]
+   (let [{:keys [out err]} (apply dispatch args)
+         captured (if (string/blank? out)
+                    err
+                    out)
+         out-path (str "test-resources/" f ".txt")]
+     (spit out-path captured)
+     (println (str out-path ":"))
+     (print captured)))
+
+ (capture "messy-full-help" "help" "--full")
+
+ (capture "messy-simple" "simple")
+
+ (capture "messy-nested-fail" "mess" "nomatch")
+ )
+
+

test/net/lewisship/messy.clj

@@ -0,0 +1,7 @@
+(ns net.lewisship.messy
+  (:require [net.lewisship.cli-tools :refer [defcommand]]))
+
+(defcommand nested
+  "Command nested under messy group/command."
+  []
+  (println "nested: ok"))