Skip to content

Commit

Permalink
Merge pull request #6 from gabriel376/gabriel376/issue-4
Browse files Browse the repository at this point in the history 
Add `:required` for `:flags`
  • Loading branch information
@plexus
plexus authored Apr 19, 2024
2 parents 89b8fe7 + 43f59f1 commit 69ac086
Show file tree
Hide file tree
Showing 4 changed files with 133 additions and 113 deletions.
4 changes: 3 additions & 1 deletion CHANGELOG.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,8 @@

## Added

- Added `:required` for `:flags`

## Fixed

## Changed
Expand Down Expand Up @@ -87,4 +89,4 @@ approaching the envisioned scope for this library.

- subcommand handling
- rudimentary flag handling
- help text generation
- help text generation
14 changes: 13 additions & 1 deletion README.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -241,7 +241,7 @@ If you are explicit about which flags you accept, then you may prefer not to let
you can set `:strict? true`. In this mode only explicitly configured flags are
accepted, others throw an error.

A final possibility is to set `:middleware` for a flag, this is a function or
Another possibility is to set `:middleware` for a flag, this is a function or
list of functions that get wrapped around the final command.

```clj
Expand All @@ -257,6 +257,18 @@ list of functions that get wrapped around the final command.
(cmd opts))))]}]}]})
```

Finally, it's possible to set `:required`, to indicate for users that a flag
must always be passed:

```clj
(cli/dispatch
{:command #'cli-test
:flags ["-v, --verbose" "Increases verbosity"
"--input FILE" "Specify the input file"
"--env=<dev|prod|staging>" {:doc "Select an environment"
:required true}] })
```

### Commands

`lambdaisland/cli` is specifically meant for CLI tools with multiple subcommands
Expand Down
137 changes: 81 additions & 56 deletions src/lambdaisland/cli.clj
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,6 @@
(ns lambdaisland.cli
(:require [clojure.string :as str]))
(:require [clojure.string :as str]
[clojure.set :as set]))

;; I've tried to be somewhat consistent with variable naming

Expand Down Expand Up @@ -60,7 +61,7 @@
(let [has-short? (some short? (mapcat (comp :flags second) flagpairs))
has-long? (some long? (mapcat (comp :flags second) flagpairs))]
(print-table
(for [[_ {:keys [flags argdoc] :as flagopts}] flagpairs]
(for [[_ {:keys [flags argdoc required] :as flagopts}] flagpairs]
(let [short (some short? flags)
long (some long? flags)]
[(str (cond
Expand All @@ -72,7 +73,9 @@
"")
long
argdoc)
(desc flagopts)]))))
(desc flagopts)
(if required "(required)" "")
]))))
(println))
(print-table
(for [[cmd cmdopts] command-pairs]
Expand All @@ -82,9 +85,7 @@
(desc cmdopts)]))))

(defn parse-error! [& msg]
(println "[FATAL]" (str/join " " msg))
(System/exit 1)
#_(throw (ex-info (str/join " " msg) {:type ::parse-error})))
(throw (ex-info (str/join " " msg) {:type ::parse-error})))

(defn add-middleware [opts {mw :middleware}]
(let [mw (if (or (nil? mw) (sequential? mw)) mw [mw])]
Expand Down Expand Up @@ -150,7 +151,7 @@
:else
[(drop argcnt cli-args) args (assoc-flag flags flagspec (map parse (take argcnt cli-args)))])
(if strict?
(parse-error! "Unknown flag: " f)
(parse-error! "Unknown flag:" f)
[cli-args args (update-flag flags {:key (keyword (str/replace f #"^-+" ""))} #(or arg ((fnil inc 0) %)))]))))
[cli-args args flags]
(if (re-find #"^-\w+" flag)
Expand Down Expand Up @@ -304,6 +305,71 @@
:else
(recur (dissoc cmdspec :flags) cli-args (conj args (str/replace arg #"^\\(.)" (fn [[_ o]] o))) (conj seen-prefixes args) flags)))))

(defn missing-flags
"Return a set of required flags in `flagmap` not present in `opts`, or `nil` if
all required flags are present."
[flagmap opts]
(let [required (->> flagmap vals (filter (comp true? :required)) (map :key) set)
received (->> opts keys set)
missing (map (fn [key]
(->> flagmap vals (map #(vector (:key %) (:flags %))) (into {}) key))
(set/difference required received))]
(seq missing)))

(defn dispatch*
([cmdspec]
(dispatch* (to-cmdspec cmdspec) *command-line-args*))
([{:keys [flags init] :as cmdspec} cli-args]
(let [init (if (or (fn? init) (var? init)) (init) init)
[cmdspec pos-args flags] (split-flags cmdspec cli-args init)
flagpairs (get cmdspec :flagpairs)]
(dispatch* cmdspec pos-args flags)))
;; Note: this three-arg version of dispatch* is considered private, it's used
;; for internal recursion on subcommands.
([{:keys [commands doc argnames command flags flagpairs flagmap]
:as cmdspec
program-name :name
:or {program-name "cli"}}
pos-args opts]

(cond
command
(if (:help opts)
(print-help program-name doc [] flagpairs)
(binding [*opts* (-> opts
(dissoc ::middleware)
(assoc ::argv pos-args)
(merge (zipmap argnames pos-args)))]
(if-let [missing (missing-flags flagmap opts)]
(parse-error! "Missing required flags:" (->> missing (map #(str/join " " %)) (str/join ", ")))
((reduce #(%2 %1) command (::middleware opts)) *opts*))))

commands
(let [[cmd & pos-args] pos-args
pos-args (vec pos-args)
cmd (when cmd (first (str/split cmd #"[ =]")))
opts (if cmd (update opts ::command (fnil conj []) cmd) opts)
command-pairs (prepare-cmdpairs commands)
command-map (into {} command-pairs)
command-match (get command-map cmd)]

(cond
command-match
(dispatch* (assoc (merge (dissoc cmdspec :command :commands) command-match)
:name (str program-name " " cmd)) pos-args opts)

(or (nil? command-match)
(nil? commands)
(:help opts))
(print-help program-name doc (for [[k v] command-pairs]
[k (if (:commands v)
(update v :commands prepare-cmdpairs)
v)])
flagpairs)

:else
(parse-error! "Expected either :command or :commands key in" cmdspec))))))

(defn dispatch
"Main entry point for com.lambdaisland/cli.
Expand Down Expand Up @@ -347,59 +413,18 @@
take an argument.
- `:middleware` Function or sequence of functions that will wrap the command
function if this flag is present.
- `:required` Boolean value to indicate if the flag is required.
This docstring is just a summary, see the `com.lambdaisland/cli` README for
details.
"
([cmdspec]
(dispatch (to-cmdspec cmdspec) *command-line-args*))
([{:keys [flags init] :as cmdspec} cli-args]
(let [init (if (or (fn? init) (var? init)) (init) init)
[cmdspec pos-args flags] (split-flags cmdspec cli-args init)
flagpairs (get cmdspec :flagpairs)]
(dispatch cmdspec pos-args flags)))
;; Note: this three-arg version of dispatch is considered private, it's used
;; for internal recursion on subcommands.
([{:keys [commands doc argnames command flags flagpairs flagmap]
:as cmdspec
program-name :name
:or {program-name "cli"}}
pos-args opts]
(cond
command
(if (:help opts)
(print-help program-name doc [] flagpairs)
(binding [*opts* (-> opts
(dissoc ::middleware)
(assoc ::argv pos-args)
(merge (zipmap argnames pos-args)))]
((reduce #(%2 %1) command (::middleware opts)) *opts*)))

commands
(let [[cmd & pos-args] pos-args
pos-args (vec pos-args)
cmd (when cmd (first (str/split cmd #"[ =]")))
opts (if cmd (update opts ::command (fnil conj []) cmd) opts)
command-pairs (prepare-cmdpairs commands)
command-map (into {} command-pairs)
command-match (get command-map cmd)]

(cond
command-match
(dispatch (assoc (merge (dissoc cmdspec :command :commands) command-match)
:name (str program-name " " cmd)) pos-args opts)

(or (nil? command-match)
(nil? commands)
(:help opts))
(print-help program-name doc (for [[k v] command-pairs]
[k (if (:commands v)
(update v :commands prepare-cmdpairs)
v)])
flagpairs)

:else
(parse-error! "Expected either :command or :commands key in" cmdspec))))))
[& args]
(try
(apply dispatch* args)
(catch Exception e
(binding [*out* *err*]
(println "[FATAL]" (.getMessage e)))
(System/exit 1))))


;;
Expand Down
91 changes: 36 additions & 55 deletions test/lambdaisland/cli_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,60 +2,41 @@
(:require
[clojure.string :as str]
[clojure.test :refer :all]
[lambdaisland.cli :as cli :refer :all]))
[lambdaisland.cli :as cli]))

;; (deftest flagstr-parsing-test
;; (is (= {"--help" {:key :help :value true}
;; "-C" {:flag "-C"
;; :key :C
;; :argcnt 0
;; :short? true
;; :description "Change working directory"}
;; "-v" {:flag "-v"
;; :key :verbose
;; :argcnt 0
;; :short? true
;; :description "Increase verbosity"}
;; "--verbose" {:flag "--verbose"
;; :key :verbose
;; :argcnt 0
;; :description "Increase verbosity"}
;; "-i" {:flag "-i"
;; :key :input
;; :argcnt 1
;; :short? true
;; :args [:input-file]
;; :description "Set input file"}
;; "--input" {:flag "--input"
;; :key :input
;; :argcnt 1
;; :args [:input-file]
;; :description "Set input file"}
;; "--output" {:flag "--output"
;; :key :output
;; :argcnt 1
;; :args [:output-file]
;; :description "Set output file"}
;; "--capture-output" {:flag "--capture-output"
;; :key :capture-output
;; :argcnt 0
;; :value true
;; :description "Enable/disable output capturing"}
;; "--no-capture-output" {:flag "--no-capture-output"
;; :key :capture-output
;; :argcnt 0
;; :value false
;; :description "Enable/disable output capturing"}}
;; (parse-flagstrs ["-C" "Change working directory"
;; "-v, --verbose" "Increase verbosity"
;; "-i, --input INPUT-FILE" {:description "Set input file"}
;; "--output=<output-file>" {:description "Set output file"}
;; "--[no-]capture-output" "Enable/disable output capturing"] ))))
(defn cmdspec-1
"Builds a cmdspec with a single command."
[required]
{:command #'identity
:flags ["-x" {:doc "flag x"
:required required}]})

;; (deftest command-argument-parsing
;; (is (= {"run" {:description "Run the thing" :argnames []}
;; "remove" {:description "remove with id" :argnames [:id]}
;; "add" {:description "Add with id" :argnames [:id]}}
;; (prepare-cmdmap ["run" {:description "Run the thing"}
;; "add ID" {:description "Add with id"}
;; "remove <id>" {:description "remove with id"}]))))
(defn cmdspec-n
"Builds a cmdspec with multiple commands."
[required]
{:commands ["run" {:command #'identity
:flags ["-x" {:doc "flag x"
:required required}]}]})

(deftest required-flag
(testing "successful exit"
(are [input args expected]
(is (= expected (cli/dispatch* input args)))
(cmdspec-1 false) [] {:lambdaisland.cli/argv []}
(cmdspec-1 true) ["-x"] {:lambdaisland.cli/argv [] :x 1}
(cmdspec-n false) ["run"] {:lambdaisland.cli/argv [] :lambdaisland.cli/command ["run"]}
(cmdspec-n true) ["run" "-x"] {:lambdaisland.cli/argv [] :lambdaisland.cli/command ["run"] :x 1}))

(testing "help exit"
(are [input args expected]
(is (= expected (with-out-str (cli/dispatch* input args))))
(cmdspec-1 false) ["-h"] "Usage: cli [-x] [<args>...]\n\n -x, flag x \n\n"
(cmdspec-1 true) ["-hx"] "Usage: cli [-x] [<args>...]\n\n -x, flag x (required)\n\n"
(cmdspec-n false) ["run" "-h"] "Usage: cli run [-x] [<args>...]\n\nReturns its argument.\n\n -x, flag x \n\n"
(cmdspec-n true) ["run" "-hx"] "Usage: cli run [-x] [<args>...]\n\nReturns its argument.\n\n -x, flag x (required)\n\n"))

(testing "unsuccessful exit"
(are [input args expected]
(is (thrown-with-msg? Exception expected (cli/dispatch* input args)))
(cmdspec-1 true) [] #"Missing required flags: -x"
(cmdspec-n true) ["run"] #"Missing required flags: -x")))

0 comments on commit 69ac086

Please sign in to comment.