cli-tools/src/net/lewisship/cli_tools/completions.clj at e4db1319fa58b872f2c9bb39bb0e8ff95004e9fb · hlship/cli-tools · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
(ns net.lewisship.cli-tools.completions
  "Support for generating zsh command completion scripts for a command."
  (:require [babashka.fs :as fs]
            [clojure.java.io :as io]
            [net.lewisship.cli-tools :refer [defcommand abort command-path]]
            [clojure.string :as string]
            selmer.util
            selmer.parser
            [clj-commons.ansi :as ansi :refer [perr]]
            [net.lewisship.cli-tools.impl :as impl]))

(defn- simplify
  [& s]
  (-> (string/join "_" s)
      (string/replace #"[^a-zA-Z0-9_]+" "_")))

(defn- render
  [file-name context]
  (print (selmer.parser/render-file (str "net/lewisship/cli_tools/" file-name ".tpl")
                                    context)))

(defn- escape
  [s]
  (string/replace s "'" "\\'"))

(defn- to-opt
  [short-option long-option summary]
  (let [both (and long-option short-option)
        [long-option' option-name] (when long-option
                                     (string/split long-option #"\s+"))]
    (apply str
           ;; Make the short and long exclusive of each other
           (when both
             (str
               "'(" short-option " " long-option' ")'{"))
           short-option
           (when both ",")
           long-option'
           (when both "}")
           ;; The $' (instead of just ') allows for \' in the string to work
           ;; correctly.
           "$'["
           (escape summary)
           "]'"
           (when option-name
             ;; TODO: meta data on the option to say what completion kind it is.
             (str ":" option-name)))))

(defn- options
  [command-map]
  (let [{:keys [fn]} command-map
        callable (requiring-resolve fn)
        {:keys [command-options]} (callable)]
    (for [[short-option long-option summary] command-options]
      (to-opt short-option long-option summary))))

(defn- extract-command
  [fn-prefix [command-name command-map]]
  (let [{:keys [fn]} command-map
        title   (-> (impl/extract-command-title command-map)
                    ansi/compose
                    string/trim)
        fn-name (simplify fn-prefix command-name)]
    ;; TODO: Support messy group/command combos
    (if fn
      {:name    command-name
       :fn-name fn-name
       :summary title
       :options (options command-map)}
      {:name    (->> command-map
                     :command-path
                     (string/join " "))
       :summary title
       :fn-name fn-name
       :subs    (map #(extract-command fn-name %) (:subs command-map))})))

(defn- render-commands
  [tool-name commands]
  (doseq [command commands]
    (if (:subs command)
      (do
        (render "group" {:tool  tool-name
                         :group command})
        (render-commands tool-name (:subs command)))
      (render "command" {:tools   tool-name
                         :command command}))))

(defn- print-tool
  [tool-name command-root _groups]
  (let [prefix   (str "_" tool-name)
        commands (->> command-root
                      (keep #(extract-command prefix %)))]
    (selmer.util/without-escaping
      (render "top-level" {:tool     tool-name
                           :commands commands})
      (render-commands tool-name commands))))

(defcommand ^{:added "0.15"} completions
  "Generate zsh command completions.  Completions can be written
  to a file or to standard output."
  [:args
   output-path ["PATH" "File to write completions to."
                :optional true]]
  (binding [impl/*introspection-mode* true]
    (let [{:keys [command-root tool-name groups]} impl/*tool-options*]
      (if output-path
        (do
          (with-open [w (-> output-path
                            fs/file
                            io/output-stream
                            io/writer)]
            (try
              (binding [*out*                w
                        ansi/*color-enabled* false]
                (print-tool tool-name command-root groups))
              (catch Throwable t
                (abort 1 [:red
                          (command-path) ": "
                          (or (ex-message t)
                              (class t))]))))
          (perr [:cyan "Wrote " output-path]))
        ;; Just write to standard output
        (binding [ansi/*color-enabled* false]
          (print-tool tool-name command-root groups))))))