|
1 | 1 | (ns lambdaisland.cli |
2 | 2 | (:require [clojure.string :as str])) |
3 | 3 |
|
4 | | -(defn print-help [prefix commands] |
5 | | - (println "Usage:" prefix "[COMMAND] [COMMAND_ARGS...]") |
6 | | - (println) |
7 | | - (doseq [[cmd {:keys [description]}] (partition 2 commands)] |
8 | | - (println (format " %-15s%s" cmd (or description ""))))) |
| 4 | +;; I've tried to be somewhat consistent with variable naming |
| 5 | + |
| 6 | +;; - cmdspec: the map passed into dispatch, with :commands and :flags, possibly augmented with :flagspecs |
| 7 | +;; - cli-args: the vector of cli arguments as the come in, or the tail of it if part has been processed |
| 8 | +;; - flagspecs: map of the possible flags with metadata, expanded to serve direct lookup, e.g. {"-i" {,,,} "--input" {,,,} "--no-input" {,,,}} |
| 9 | +;; - flagspec: map of how to deal with a given flag {:flag "--foo", :key :foo, :short? false, :argcnt 1} |
| 10 | +;; - argcnt: number of arguments a given flag consumes (usually zero or one, but could be more) |
| 11 | +;; - args/pos-args: vector of positional arguments that will go to the command |
| 12 | +;; - opts: options that will go the command, based on any parsed flags |
| 13 | +;; - commands: specification of (sub)-commands, can be vector (for order) or map |
| 14 | +;; - raw-flagspecs: flags as specified in the cmdspec, without normalization |
| 15 | +;; - cmd: a single (sub) command like `"add"` or `"widgets"` |
| 16 | + |
| 17 | +(defn print-help [{:keys [commands flags] :as cmdspec} _] |
| 18 | + (let [commands (if (vector? commands) (partition 2 commands) commands)] |
| 19 | + (println "Usage:" (or (:name cmdspec) "cli") "[command...] [flags-or-args...]") |
| 20 | + (println) |
| 21 | + (doseq [[cmd {:keys [description]}] commands] |
| 22 | + (println (format (str " %-" (+ 3 (apply max (map (comp count first) commands))) "s%s") cmd (or description "")))))) |
9 | 23 |
|
10 | 24 | (defn parse-error! [& msg] |
11 | 25 | (throw (ex-info (str/join " " msg) {:type ::parse-error}))) |
|
52 | 66 | {:value (not negative?)}) |
53 | 67 | flagopts)))) |
54 | 68 |
|
55 | | -(defn parse-flagspecs [flags] |
| 69 | +(defn parse-flagspecs [raw-flagspecs] |
56 | 70 | (into {"--help" {:key :help :value true}} |
57 | 71 | (map (juxt :flag identity)) |
58 | 72 | (mapcat |
59 | 73 | (fn [[flagspec flagopts]] |
60 | 74 | (parse-flagspec flagspec flagopts)) |
61 | | - (if (vector? flags) (partition 2 flags) flags)))) |
| 75 | + (if (vector? raw-flagspecs) (partition 2 raw-flagspecs) raw-flagspecs)))) |
62 | 76 |
|
63 | 77 | (defn dispatch |
64 | 78 | ([cmdspec] |
|
68 | 82 | (dispatch cmdspec pos-args flags))) |
69 | 83 | ([{:keys [commands flags name] :as cmdspec} pos-args opts] |
70 | 84 | (let [[cmd & pos-args] pos-args |
| 85 | + opts (update opts ::command (fnil conj []) cmd) |
71 | 86 | program-name (or (:name cmdspec) "cli") |
72 | 87 | command-map (if (vector? commands) (apply hash-map commands) commands) |
73 | 88 | command-vec (if (vector? commands) commands (into [] cat commands)) |
|
79 | 94 | (nil? commands)) |
80 | 95 | (= "help" cmd) |
81 | 96 | (:help opts)) |
82 | | - (print-help program-name command-vec) |
| 97 | + (print-help cmdspec opts) |
83 | 98 |
|
84 | 99 | :else |
85 | 100 | (if subcommands |
86 | 101 | (dispatch {:commands subcommands :flags flags :name (str program-name " " cmd)} pos-args opts) |
87 | 102 | (command pos-args opts)))))) |
88 | | - |
89 | | -(with-out-str |
90 | | - (dispatch |
91 | | - {:commands ["run" {:command (fn [args flags] |
92 | | - (print "RUN" args flags))}]} |
93 | | - ["run"])) |
94 | | -;; => "RUN nil nil" |
95 | | - |
96 | | -(with-out-str |
97 | | - (dispatch |
98 | | - {:commands ["run" {:command (fn [args flags] |
99 | | - (print "RUN" args flags))}]} |
100 | | - ["run" "hello"])) |
101 | | -;; => "RUN (hello) nil" |
102 | | - |
103 | | -(with-out-str |
104 | | - (dispatch |
105 | | - {:commands ["run" {:command (fn [args flags] |
106 | | - (print "RUN" args flags)) |
107 | | - }]} |
108 | | - ["help"])) |
109 | | -;; => "Usage: cli [COMMAND] [COMMAND_ARGS...]\n\n run \n" |
110 | | - |
111 | | -(with-out-str |
112 | | - (dispatch |
113 | | - {:commands ["run" {:command (fn [args flags] |
114 | | - (print "RUN" args flags)) |
115 | | - :description "Do something"}]} |
116 | | - ["help"])) |
117 | | -;; => "Usage: cli [COMMAND] [COMMAND_ARGS...]\n\n run Do something\n" |
118 | | - |
119 | | -(with-out-str |
120 | | - (dispatch |
121 | | - {:commands {"run" {:command (fn [args flags] |
122 | | - (print "RUN" args flags)) |
123 | | - :description "Do something"}}} |
124 | | - ["help"])) |
125 | | - |
126 | | -(defn show-args [cmd] |
127 | | - (fn [args flags] |
128 | | - (print (str/upper-case cmd) args flags))) |
129 | | - |
130 | | -(println |
131 | | - (dispatch |
132 | | - {:commands {"run" {:command (show-args "run") |
133 | | - :description "Do something"} |
134 | | - "widget" {:description "Work with widgets" |
135 | | - :commands |
136 | | - ["ls" {:description "List widgets" |
137 | | - :command (show-args "widget ls")} |
138 | | - "add" {:description "Add widget" |
139 | | - :command (show-args "widget add")}]}}} |
140 | | - ["widget" "ls" "x" "--recursive" "--help"])) |
141 | | - |
142 | | -(println |
143 | | - (dispatch |
144 | | - {:commands {"run" {:command (show-args "run") |
145 | | - :description "Do something"} |
146 | | - "widget" {:description "Work with widgets" |
147 | | - :commands |
148 | | - ["ls" {:description "List widgets" |
149 | | - :command (show-args "widget ls")} |
150 | | - "add" {:description "Add widget" |
151 | | - :command (show-args "widget add")}]}} |
152 | | - } |
153 | | - ["widget" "ls" "x" "--recursive" "--help"])) |
154 | | - |
155 | | -(dispatch |
156 | | - {:commands {"run" {:command (show-args "run") |
157 | | - :description "Do something"} |
158 | | - "widget" {:description "Work with widgets" |
159 | | - :commands |
160 | | - ["ls" {:description "List widgets" |
161 | | - :command (show-args "widget ls")} |
162 | | - "add" {:description "Add widget" |
163 | | - :command (show-args "widget add")}]}} |
164 | | - :flags ["-i,--input FILE" {:desc "Specify input file"} |
165 | | - "--output FILE" "Specify output file"]} |
166 | | - ["widget" "ls" "--input" "INPUT" "--output" "OUTPUT"]) |
167 | | - |
168 | | - |
169 | | -(parse-flagspec |
170 | | - "-i,--input FILE" {:desc "Specify input file"}) |
171 | | - |
172 | | -(parse-flagspecs |
173 | | - ["-i,--input FILE" {:desc "Specify input file"} |
174 | | - "--output FILE" "Specify output file" |
175 | | - "--[no-]foo" ""]) |
176 | | - |
177 | | -(let [cmdspec |
178 | | - {:commands {"run" {:command (show-args "run") |
179 | | - :description "Do something"} |
180 | | - "widget" {:description "Work with widgets" |
181 | | - :commands |
182 | | - ["ls" {:description "List widgets" |
183 | | - :command (show-args "widget ls")} |
184 | | - "add" {:description "Add widget" |
185 | | - :command (show-args "widget add")}]}} |
186 | | - :flags ["-i,--input FILE" {:desc "Specify input file" |
187 | | - :key "XXX"} |
188 | | - "--output FILE" "Specify output file"]}] |
189 | | - (split-flags |
190 | | - (assoc cmdspec :flagspecs (parse-flagspecs (:flags cmdspec))) |
191 | | - ["widget" "ls" "--help" "--input" "INPUT" "--output" "OUTPUT"])) |
192 | | - |
193 | | -(dispatch |
194 | | - {:commands {"run" {:command (show-args "run") |
195 | | - :description "Do something"} |
196 | | - "widget" {:description "Work with widgets" |
197 | | - :commands |
198 | | - ["ls" {:description "List widgets" |
199 | | - :command (show-args "widget ls") |
200 | | - :help "List widgets in the order they exist."} |
201 | | - "add" {:description "Add widget" |
202 | | - :command (show-args "widget add")}]}} |
203 | | - :flags ["-i,--input FILE" {:desc "Specify input file"} |
204 | | - "--output FILE" "Specify output file"]} |
205 | | - ["widget" "ls" "--help"]) |
0 commit comments