From 9202845171b6bd1b6ef4fc48c1e4c87979044002 Mon Sep 17 00:00:00 2001 From: "carpentry-heartbeat[bot]" Date: Mon, 27 Jul 2026 13:30:09 +0200 Subject: [PATCH] Accept bundled and attached short options in parse-from MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `-av`, `-n5` and `-avn 5` were all rejected as unknown options, so the invocation style every POSIX tool accepts did not work even though the library advertises short flags. A single-dash token is now decomposed into single-character short options when — and only when — it matches no option exactly. That exact lookup still runs first, so multi-character short names, long names given with a single dash, `--long=value` and `-n=7` are untouched, and `--` end-of-options plus negative-number positionals never reach the flag branch at all. Booleans continue a bundle; the first value-taking option ends it and takes the rest of the token, or the next token, as its value; an unknown letter rejects the whole token without applying any of it. --- README.md | 23 +++++ cli.carp | 69 +++++++++++++ docs/CLI.html | 6 ++ test/cli.carp | 270 ++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 368 insertions(+) diff --git a/README.md b/README.md index 058ed3a..fa9a09c 100644 --- a/README.md +++ b/README.md @@ -44,6 +44,29 @@ manually. Booleans neither take defaults nor options. If a boolean flag receives a value, it will be read as true unless it’s the string `false`. +### Short flag bundling + +Short options can be written the way you are used to typing them: `ls -la`, +`tar -xzf archive.tar.gz`, `grep -rn pattern`. A single-dash token that matches +no option exactly is decomposed into single-character short options, so `-av` is +`-a -v`. + +Boolean options continue the bundle. The first option that takes a value ends +it and reads the rest of the token as its value, or the next token if there is +nothing left: + +``` +-n5 ; num = 5 +-avn5 ; all, verbose, num = 5 +-avn 5 ; all, verbose, num = 5 +``` + +Only single-character short names take part in this. A token that names an +option exactly is always resolved as that option first, so a multi-character +short name like `th` keeps working, and so does a long name given with a single +dash. If any letter of a bundle is not a known short option, the whole token is +rejected — nothing in it is applied. + ### Positional arguments Positional arguments are non-flag tokens matched by position. Build them with diff --git a/cli.carp b/cli.carp index 59140f8..5a1d302 100644 --- a/cli.carp +++ b/cli.carp @@ -176,6 +176,14 @@ please use [`pos-str`](#pos-str), [`pos-int`](#pos-int), or (break)))) found)) + (defn short? [m s] + (let-do [found false + vs (values m)] + (for [i 0 (length vs)] + (let [e (unsafe-nth vs i)] + (when-do (= (Pair.b (Pair.a e)) s) (set! found true) (break)))) + found)) + (defn set? [m s] (let-do [found false vs (values m)] @@ -376,6 +384,21 @@ Options:" (StaticArray.unsafe-nth &System.args 0) &(options-str p) (Parser.descr (Positional.description pos)))) (IO.println "")))))) + (private bundle-stop) + (hidden bundle-stop) + ; index of the first character of `flag` that is not a boolean short option, + ; or its length if they all are + (defn bundle-stop [values flag] + (let-do [n (String.length flag) + stop n] + (for [i 0 n] + (let [c (String.byte-slice flag i (Int.inc i))] + (unless-do (and (CmdMap.short? values &c) + (CmdMap.type? values &c &(Tag.TBoolean))) + (set! stop i) + (break)))) + stop)) + (hidden parse-from) ; the workhorse behind `parse` and `App` dispatch: parses an explicit argument ; array against `p`. Non-flag tokens fill positionals in order; flags and @@ -436,6 +459,45 @@ Options:" (StaticArray.unsafe-nth &System.args 0) &(options-str p) (Parser.descr (break)))) (or (= k "help") (= k "h")) (do (set! res (Result.Error @"")) (break)) + (and (<= (length &splt) 1) + (not (empty? k)) + (not (starts-with? x "--"))) + (let [n (String.length k) + stop (bundle-stop &values k) + c (if (< stop n) + (String.byte-slice k stop (Int.inc stop)) + @"") + rest (if (< stop n) + (String.byte-slice k (Int.inc stop) n) + @"") + known (or (= stop n) (CmdMap.short? &values &c))] + (cond + (and (not known) (= &c "h")) + (do (set! res (Result.Error @"")) (break)) + (not known) + (do + (set! res + (Result.Error (fmt "Unknown option: %s" x))) + (break)) + (do + (for [j 0 stop] + (CmdMap.put! &values + &(String.byte-slice k j (Int.inc j)) + "true")) + (cond + (= stop n) + (when (Maybe.just? &v) (set! i (Int.dec i))) + (not (empty? &rest)) + (do + (when (Maybe.just? &v) (set! i (Int.dec i))) + (CmdMap.put! &values &c &rest)) + (match v + (Maybe.Just val) (CmdMap.put! &values &c &val) + (Maybe.Nothing) + (do + (set! res + (Result.Error (fmt "No value for: %s" &c))) + (break))))))) (do (set! res (Result.Error (fmt "Unknown option: %s" x))) (break)))) @@ -520,6 +582,13 @@ parsing — every following token becomes a positional even if it starts with `- — and a token shaped like a negative number (`-5`, `-3.14`) is a positional, not an unknown option. +A single-dash token that matches no option exactly is decomposed into +single-character short options, so `-av` is `-a -v`. Booleans continue the +bundle; the first option that takes a value ends it and reads the rest of the +token as its value, or the next token if nothing is left (`-n5`, `-avn5`, +`-avn 5`). If any letter is not a known short option the whole token is +rejected. + On failure it returns an `Error` with a message — except that an *empty* error message means `--help` (or `-h`) was requested. Override that flag if you don’t want the built-in help behaviour.") diff --git a/docs/CLI.html b/docs/CLI.html index dafc892..80814f0 100644 --- a/docs/CLI.html +++ b/docs/CLI.html @@ -383,6 +383,12 @@

parsing — every following token becomes a positional even if it starts with - — and a token shaped like a negative number (-5, -3.14) is a positional, not an unknown option.

+

A single-dash token that matches no option exactly is decomposed into +single-character short options, so -av is -a -v. Booleans continue the +bundle; the first option that takes a value ends it and reads the rest of the +token as its value, or the next token if nothing is left (-n5, -avn5, +-avn 5). If any letter is not a known short option the whole token is +rejected.

On failure it returns an Error with a message — except that an empty error message means --help (or -h) was requested. Override that flag if you don’t want the built-in help behaviour.

diff --git a/test/cli.carp b/test/cli.carp index 20e62bf..808277c 100644 --- a/test/cli.carp +++ b/test/cli.carp @@ -18,6 +18,29 @@ (CLI.App.add "commit" &commit-parser) (CLI.App.add "push" &push-parser))) +; an ls-like parser the short-flag bundling tests below drive + +(def bundling-parser + (=> (CLI.new @"bundling") + (CLI.add &(CLI.bool "all" "a" "list all")) + (CLI.add &(CLI.bool "long" "l" "long format")) + (CLI.add &(CLI.bool "verbose" "v" "be verbose")) + (CLI.add &(CLI.int "num" "n" "a number" false)))) + +; `th` is a two-character short name, so `-th` must stay an exact hit + +(def exact-parser + (=> (CLI.new @"exact") + (CLI.add &(CLI.bool "all" "a" "list all")) + (CLI.add &(CLI.bool "hat" "t" "wear a hat")) + (CLI.add &(CLI.str "thing" "th" "a thing" false)))) + +(def strict-parser + (=> (CLI.new @"strict") + (CLI.add &(CLI.bool "all" "a" "list all")) + (CLI.add &(CLI.str "mode" "m" "a mode" true)) + (CLI.add &(CLI.str "kind" "k" "a kind" false @"x" &[@"x" @"y"])))) + ; `CLI.parse-from` is internal, so the flat-parser regression tests below reach ; it through a one-subcommand `App`: prepend a dummy subcommand name, dispatch, ; and collapse the `Dispatch` back to the `Result` shape those assertions expect. @@ -605,6 +628,239 @@ (Result.Error _) (assert-true test false "option then -- then -x unexpectedly errored"))) + ; --------------------------------------------------------------------------- + ; Short flag bundling + ; --------------------------------------------------------------------------- + + (let-do [res (flat-parse &bundling-parser &[@"-av"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "all")) + "-av sets the first bundled boolean")] + (assert-equal &t + "true" + &(CLI.Type.str &(Map.get &m "verbose")) + "-av sets the second bundled boolean")) + (Result.Error _) (assert-true test false "-av unexpectedly errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-alv"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "all")) + "-alv sets all")] + (set! t + (assert-equal &t + "true" + &(CLI.Type.str &(Map.get &m "long")) + "-alv sets long")) + (assert-equal &t + "true" + &(CLI.Type.str &(Map.get &m "verbose")) + "-alv sets verbose")) + (Result.Error _) (assert-true test false "-alv unexpectedly errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-avn5"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "verbose")) + "-avn5 sets the booleans before the value option")] + (assert-equal &t + "5" + &(CLI.Type.str &(Map.get &m "num")) + "-avn5 reads the rest of the token as the value")) + (Result.Error _) (assert-true test false "-avn5 unexpectedly errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-avn" @"5"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "all")) + "-avn 5 sets the bundled booleans")] + (assert-equal &t + "5" + &(CLI.Type.str &(Map.get &m "num")) + "-avn 5 reads the next token as the value")) + (Result.Error _) (assert-true test false "-avn 5 unexpectedly errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-n5"])] + (match res + (Result.Success m) + (assert-equal test + "5" + &(CLI.Type.str &(Map.get &m "num")) + "-n5 attaches the value to a lone short option") + (Result.Error _) (assert-true test false "-n5 unexpectedly errored"))) + + ; an unknown letter fails the whole token, and nothing in it is applied + + (let-do [res (flat-parse &bundling-parser &[@"-avq"])] + (match res + (Result.Error e) + (assert-equal test + "Unknown option: -avq" + &e + "an unknown letter fails the bundle by its full token") + (Result.Success _) (assert-true test false "-avq should have errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-qav"])] + (match res + (Result.Error e) + (assert-equal test + "Unknown option: -qav" + &e + "an unknown leading letter fails the bundle too") + (Result.Success _) (assert-true test false "-qav should have errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-avn"])] + (match res + (Result.Error e) + (assert-equal test + "No value for: n" + &e + "a bundle ending in a value option with no value names that option") + (Result.Success _) + (assert-true test false "-avn without a value should have errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-h"])] + (match res + (Result.Error e) (assert-equal test "" &e "-h still signals help") + (Result.Success _) + (assert-true test false "-h should have signalled help"))) + + (let-do [res (flat-parse &bundling-parser &[@"-ah"])] + (match res + (Result.Error e) + (assert-equal test "" &e "an h inside a bundle signals help") + (Result.Success _) + (assert-true test false "-ah should have signalled help"))) + + ; a bundle is only decomposed when the whole token matches nothing exactly + + (let-do [res (flat-parse &exact-parser &[@"-th" @"hat"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "hat" + &(CLI.Type.str &(Map.get &m "thing")) + "a multi-character short name wins over decomposition")] + (assert-false &t + (Map.contains? &m "hat") + "the exact hit does not also set the letters it is made of")) + (Result.Error _) (assert-true test false "-th unexpectedly errored"))) + + (let-do [res (flat-parse &exact-parser &[@"-ta"])] + (match res + (Result.Success m) + (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "hat")) + "a token with no exact match is decomposed") + (Result.Error _) (assert-true test false "-ta unexpectedly errored"))) + + ; a double dash is a long option, never a bundle + + (let-do [res (flat-parse &bundling-parser &[@"--av"])] + (match res + (Result.Error e) + (assert-equal test + "Unknown option: --av" + &e + "a double-dashed token is not decomposed") + (Result.Success _) (assert-true test false "--av should have errored"))) + + (let-do [res (flat-parse &bundling-parser &[@"-"])] + (match res + (Result.Error e) + (assert-equal test "Unknown option: -" &e "a bare - is still unknown") + (Result.Success _) (assert-true test false "- should have errored"))) + + (let-do [p (=> (CLI.new @"flat") + (CLI.add &(CLI.bool "all" "a" "list all")) + (CLI.add-pos &(CLI.pos-str "target" "a target" true))) + res (flat-parse &p &[@"--" @"-av"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "-av" + &(CLI.Type.str &(Map.get &m "target")) + "a bundle after -- is a positional")] + (assert-false &t + (Map.contains? &m "all") + "a bundle after -- sets no flags")) + (Result.Error _) + (assert-true test false "-- then -av unexpectedly errored"))) + + (let-do [p (=> (CLI.new @"flat") + (CLI.add &(CLI.bool "all" "a" "list all")) + (CLI.add-pos &(CLI.pos-int "n" "a number" true))) + res (flat-parse &p &[@"-5"])] + (match res + (Result.Success m) + (assert-equal test + "-5" + &(CLI.Type.str &(Map.get &m "n")) + "a negative number is a positional, not a bundle") + (Result.Error _) (assert-true test false "-5 unexpectedly errored"))) + + ; a value option in the middle of a bundle swallows the rest, as getopt does + + (let-do [res (flat-parse &strict-parser &[@"-amb"])] + (match res + (Result.Success m) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get &m "all")) + "-amb sets the leading boolean")] + (assert-equal &t + "b" + &(CLI.Type.str &(Map.get &m "mode")) + "-amb gives the rest of the token to the value option")) + (Result.Error _) (assert-true test false "-amb unexpectedly errored"))) + + (let-do [res (flat-parse &strict-parser &[@"-am" @"b"])] + (match res + (Result.Success m) + (assert-equal test + "b" + &(CLI.Type.str &(Map.get &m "mode")) + "a bundle satisfies a required option") + (Result.Error _) (assert-true test false "-am b unexpectedly errored"))) + + (let-do [res (flat-parse &strict-parser &[@"-a"])] + (match res + (Result.Error e) + (assert-equal test + "Required option missing: --mode" + &e + "a bundle does not exempt a required option") + (Result.Success _) + (assert-true test false "a missing required option should have errored"))) + + (let-do [res (flat-parse &strict-parser &[@"-amb" @"-kz"])] + (match res + (Result.Error e) + (assert-equal test + "Option kind received an invalid option z (Options are x, y)" + &e + "a value set through a bundle is validated against its options") + (Result.Success _) (assert-true test false "-kz should have errored"))) + + (let-do [res (flat-parse &strict-parser &[@"-amb" @"-ky"])] + (match res + (Result.Success m) + (assert-equal test + "y" + &(CLI.Type.str &(Map.get &m "kind")) + "a valid value set through a bundle passes validation") + (Result.Error _) (assert-true test false "-ky unexpectedly errored"))) + ; --------------------------------------------------------------------------- ; App / subcommands ; --------------------------------------------------------------------------- @@ -666,6 +922,20 @@ false "subcommand boolean --flag=false unexpectedly errored"))) + (let-do [app (=> (CLI.App.new @"a lister") (CLI.App.add "ls" &bundling-parser)) + res (CLI.App.parse-from &app &[@"ls" @"-avn5"])] + (match res + (CLI.Dispatch.Parsed pair) + (let-do [t (assert-equal test + "true" + &(CLI.Type.str &(Map.get (Pair.b &pair) "all")) + "a subcommand accepts a bundle")] + (assert-equal &t + "5" + &(CLI.Type.str &(Map.get (Pair.b &pair) "num")) + "a subcommand accepts an attached value in a bundle")) + _ (assert-true test false "ls -avn5 unexpectedly errored"))) + (let-do [res (CLI.App.parse-from &git &[@"frobnicate"])] (match res (CLI.Dispatch.Failure e)