Make some improvements to the shell completion

Author: plexus

README.md

@@ -614,21 +614,21 @@ bones, it can complete subcommands and flags, and is aware of nested
 subcommands, but don't expect it to be perfect. There is no smart completion of
 flag values yes.
 
-To get started run the hidden `__install_zsh_completions` subcommand. This will
-create `~/.zsh/completions/_licli`, and add a section to your `~/.zshrc` to
+To get started run the hidden `__licli install-completions` subcommand. This
+will create `~/.zsh/completions/_licli`, and add a section to your `~/.zshrc` to
 autoload it and associate it with the current command.
 
 e.g.
 
 ```
-bin/my_command __install_zsh_completions
+bin/my_command __licli install-completions
 ```
 
 When calling from Clojure (not Babashka), pass the full path to the executable
 as an argument. You can easily use `realpath` for that.
 
 ```
-bin/my_command __install_zsh_completions `realpath bin/my_command`
+bin/my_command __licli install-completions `realpath bin/my_command`
 ```
 
 Other shells may come in the future. Contributions to the shell completion are welcome!

resources/lambdaisland/cli/_licli.zsh

@@ -2,10 +2,7 @@
 
 _licli() {
     local completion_output
-    completion_output="$(\
-        ${words[1]} __zsh_completions \
-        -- "${words[@]}" \
-    )"
+    completion_output="$( ${words[1]} __licli completions -- "${words[@]}" )"
 
     if [ -n "$completion_output" ]; then
         local -a pairs

src/lambdaisland/cli.clj

@@ -7,6 +7,7 @@
    [clojure.pprint :as pprint]
    [clojure.set :as set]
    [clojure.string :as str]
+   [lambdaisland.cli.cmdspec :as cmdspec]
    [lambdaisland.cli.completions :as completions]))
 
 ;; I've tried to be somewhat consistent with variable naming
@@ -207,49 +208,19 @@
      (map #(str "-" %) (next flag))
      [flag])))
 
-(def args-re #" ([A-Z][A-Z_-]*)|[= ]<([^>]+)>")
 (def flag-re #"^(--?)(\[no-\])?(.+)$")
 
-(defn parse-arg-names [str]
-  [(str/split (str/replace str args-re "") #",\s*")
-   (str/join (map first (re-seq args-re str)))
-   (mapv (fn [[_ u l]] (keyword (str/lower-case (or u l)))) (re-seq args-re str))])
-
-(defn to-cmdspec [?var]
-  (cond
-    (var? ?var)
-    (if (fn? @?var)
-      (assoc (meta ?var) :command ?var)
-      (merge (meta ?var) @?var))
-
-    (fn? ?var)
-    {:command ?var}
-
-    (var? (:command ?var))
-    (merge (meta (:command ?var)) ?var)
-
-    :else
-    ?var))
-
-(defn prepare-cmdpairs [commands]
-  (let [m (if (vector? commands) (partition 2 commands) commands)]
-    (map (fn [[k v]]
-           (let [v (to-cmdspec v)
-                 [[cmd] doc argnames] (parse-arg-names k)]
-             [cmd (assoc v :argdoc doc :argnames argnames)]))
-         m)))
-
 (defn cmd->flags [cmdspec args]
   (if (seq args)
     (when-let [cmds (:commands cmdspec)]
-      (cmd->flags (get (into {} (prepare-cmdpairs (:commands cmdspec)))
+      (cmd->flags (get (into {} (cmdspec/prepare-cmdpairs (:commands cmdspec)))
                        (first args))
                   (rest args)))
     (:flags cmdspec)))
 
 (defn parse-flagstr [flagstr flagopts]
   (let [;; support "--foo=<hello>" and "--foo HELLO"
-        [flags argdoc argnames] (parse-arg-names flagstr)
+        [flags argdoc argnames] (cmdspec/parse-arg-names flagstr)
         argcnt                  (count argnames)
         ;; e.g. "-i,--input, --[no-]foo ARG"
         flagstrs                (map #(re-find flag-re %) flags)
@@ -403,7 +374,7 @@
 
 (defn dispatch*
   ([cmdspec]
-   (dispatch* (to-cmdspec cmdspec) *command-line-args*))
+   (dispatch* (cmdspec/to-cmdspec cmdspec) *command-line-args*))
   ([{:keys [flags init] :as cmdspec} cli-args]
    (let [init                     (if (or (fn? init) (var? init)) (init) init)
          init                     (assoc init ::sources (into {} (map (fn [k] [k "Initial context"])) (keys init)))
@@ -422,7 +393,7 @@
                                                 (instance? clojure.lang.MultiFn middleware))
                                           [middleware]
                                           middleware))
-         command-pairs (when commands (prepare-cmdpairs commands))
+         command-pairs (when commands (cmdspec/prepare-cmdpairs commands))
          command-map (when commands (update-keys (into {} command-pairs)
                                                  #(first (str/split % #"[ =]"))))]
      (cond
@@ -485,18 +456,18 @@
                              (:doc command-match)
                              doc)
                            (for [[k v] (if command-match
-                                         (-> command-match :commands prepare-cmdpairs)
+                                         (-> command-match :commands cmdspec/prepare-cmdpairs)
                                          command-pairs)]
                              [k (if (:commands v)
-                                  (update v :commands prepare-cmdpairs)
+                                  (update v :commands cmdspec/prepare-cmdpairs)
                                   v)])
                            argnames
                            flagpairs)
                (print-help program-name
                            doc
                            (for [[k v] command-pairs]
                              [k (if (:commands v)
-                                  (update v :commands prepare-cmdpairs)
+                                  (update v :commands cmdspec/prepare-cmdpairs)
                                   v)])
                            argnames
                            flagpairs)))

src/lambdaisland/cli/cmdspec.clj

@@ -0,0 +1,36 @@
+(ns lambdaisland.cli.cmdspec
+  "Some of the command spec parsing extracted so it can be reused in
+  lambdaisland.cli.completions"
+  (:require
+   [clojure.string :as str]))
+
+(def args-re #" ([A-Z][A-Z_-]*)|[= ]<([^>]+)>")
+
+(defn parse-arg-names [str]
+  [(str/split (str/replace str args-re "") #",\s*")
+   (str/join (map first (re-seq args-re str)))
+   (mapv (fn [[_ u l]] (keyword (str/lower-case (or u l)))) (re-seq args-re str))])
+
+(defn to-cmdspec [?var]
+  (cond
+    (var? ?var)
+    (if (fn? @?var)
+      (assoc (meta ?var) :command ?var)
+      (merge (meta ?var) @?var))
+
+    (fn? ?var)
+    {:command ?var}
+
+    (var? (:command ?var))
+    (merge (meta (:command ?var)) ?var)
+
+    :else
+    ?var))
+
+(defn prepare-cmdpairs [commands]
+  (let [m (if (vector? commands) (partition 2 commands) commands)]
+    (map (fn [[k v]]
+           (let [v (to-cmdspec v)
+                 [[cmd] doc argnames] (parse-arg-names k)]
+             [cmd (assoc v :argdoc doc :argnames argnames)]))
+         m)))

src/lambdaisland/cli/completions.clj

@@ -1,23 +1,26 @@
 (ns lambdaisland.cli.completions
   (:require
+   [lambdaisland.cli.cmdspec :as cmdspec]
    [clojure.java.io :as io]
    [clojure.string :as str]))
 
+(declare with-completions)
+
 (defn zsh-completions [cmdspec {:lambdaisland.cli/keys [argv] :as opts}]
   (let [cmdspec (reduce
                  (fn [cmdspec arg]
-                   (let [commands ((resolve 'lambdaisland.cli/prepare-cmdpairs) (:commands cmdspec))]
+                   (let [commands (cmdspec/prepare-cmdpairs (:commands (with-completions cmdspec)))]
                      (if-let [command-match (get (into {} commands) arg)]
                        (-> cmdspec
                            (dissoc :command :commands :middleware)
                            (merge command-match)
-                           (assoc :flagmap (merge (:flagmap ((resolve 'lambdaisland.cli/to-cmdspec) cmdspec))
-                                                  (:flagmap ((resolve 'lambdaisland.cli/to-cmdspec) command-match)))))
+                           (assoc :flagmap (merge (:flagmap (cmdspec/to-cmdspec cmdspec))
+                                                  (:flagmap (cmdspec/to-cmdspec command-match)))))
                        cmdspec)))
                  cmdspec
                  (butlast (next argv)))]
-    (doseq [[cmd {:keys [doc]}] ((resolve 'lambdaisland.cli/prepare-cmdpairs) (:commands cmdspec))]
-      (println (str cmd (when doc ":") doc)))
+    (doseq [[cmd {:keys [doc]}] (cmdspec/prepare-cmdpairs (:commands cmdspec))]
+      (println (str cmd (when doc ":") (first (str/split doc #"\R")))))
     (doseq [[flag {:keys [doc]}] (:flagmap cmdspec)]
       (println (str flag ":" (or doc (str/replace flag #"^-+" "")))))))
 
@@ -32,27 +35,51 @@
       (println "e.g. bin/my_script __install_zsh_completions /full/path/to/bin/my_script")
       (System/exit -1))
     (when-not (.exists cdir) (.mkdirs cdir))
+    (println "Creating" (str (io/file cdir "_licli")))
     (spit (io/file cdir "_licli")
           (slurp (io/resource "lambdaisland/cli/_licli.zsh")))
     ;; we could get a lot fancier here with detecting the block we previously
     ;; added, but this is an ok start
-    (spit zshrc-path
-          (str zshrc
-               "\n"
-               (when-not (re-find #"(?m)^fpath=.*\~/.zsh/completions" zshrc)
-                 (str "\n# lambdaisland.cli completions\nfpath=(~/.zsh/completions $fpath)\n"))
-               (when-not (re-find #"(?m)^autoload -Uz compinit$" zshrc)
-                 (str "autoload -Uz compinit\n"))
-               (when-not (re-find #"(?m)^compinit$" zshrc)
-                 (str "compinit\n"))
-               (let [base-name (last (str/split script-name #"/"))]
-                 (str "compdef _licli " script-name " */" base-name " " base-name))))))
+    (let [stanza (str
+                  (when-not (re-find #"(?m)^fpath=.*\~/.zsh/completions" zshrc)
+                    (str "\n# lambdaisland.cli completions\nfpath=(~/.zsh/completions $fpath)\n"))
+                  (when-not (re-find #"(?m)^autoload -Uz compinit$" zshrc)
+                    (str "autoload -Uz compinit\n"))
+                  (when-not (re-find #"(?m)^compinit$" zshrc)
+                    (str "compinit\n"))
+                  (let [base-name (last (str/split script-name #"/"))]
+                    (str "compdef _licli " script-name " */" base-name " " base-name)))]
+      (println "Updating" (str zshrc-path) ", adding:")
+      (println stanza)
+      (spit zshrc-path (str zshrc "\n" stanza)))))
+
+(defn install-bash-completions [opts]
+  (throw (ex-info {} "Not implemented"))
+  )
+
+(defn install-completions
+  "Do the necessary setup to get shell completions. Shell will be guessed from
+  $SHELL, unless explicitly specified."
+  {:flags ["--zsh" "Do zsh setup"
+           "--bash" "Do bash setup"]}
+  [opts]
+  (let [shell (cond
+                (:zsh opts) :zsh
+                (:bash opts) :bash
+                :else (keyword (last (str/split (System/getenv "SHELL") #"/"))))]
+    (case shell
+      :zsh (install-zsh-completions opts)
+      :bash (install-bash-completions opts))))
 
 (defn with-completions [cmdspec]
   (update cmdspec
           :commands
           (fnil into [])
-          ["__zsh_completions" {:no-doc true
-                                :command (partial zsh-completions cmdspec)}
-           "__install_zsh_completions" {:no-doc true
-                                        :command #'install-zsh-completions}]))
+          ["__licli"
+           {:no-doc true
+            :commands
+            ["completions" {:doc "Generate completions based on partially completed arguments
+
+called by shell functions to do the actual completing."
+                            :command (partial zsh-completions cmdspec)}
+             "install-completions" #'install-completions]}]))