Merge pull request #6 from gabriel376/gabriel376/issue-4

Add `:required` for `:flags`

Author: plexus

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 ## Added
 
+- Added `:required` for `:flags`
+
 ## Fixed
 
 ## Changed
@@ -87,4 +89,4 @@ approaching the envisioned scope for this library.
 
 - subcommand handling 
 - rudimentary flag handling
-- help text generation
+- help text generation

README.md

@@ -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
@@ -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

src/lambdaisland/cli.clj

@@ -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
 
@@ -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
@@ -72,7 +73,9 @@
                      "")
                    long
                    argdoc)
-              (desc flagopts)]))))
+              (desc flagopts)
+              (if required "(required)" "")
+              ]))))
       (println))
     (print-table
      (for [[cmd cmdopts] command-pairs]
@@ -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])]
@@ -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)
@@ -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.
 
@@ -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))))
 
 
 ;;

test/lambdaisland/cli_test.clj

@@ -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")))