diff --git a/README.md b/README.md index bf96625..5d59374 100644 --- a/README.md +++ b/README.md @@ -213,6 +213,8 @@ The new `Input` module contains functions for the underlying System.CommandLine * `validateDirectoryExists` ensures that the `DirectoryInfo` exists * `addValidator` allows you to add a validator to the underlying `Option` or `Argument` * `acceptOnlyFromAmong` validates the allowed values for an `Option` or `Argument` +* `mapFromAmong` validates allowed values against `string * 'T` tuples, providing the typed value +* `mapFromAmongWith` validates allowed values against `string * 'T` tuples using a given `StringComparer` * `customParser` allows you to parse the input tokens using a custom parser function. * `tryParse` allows you to parse the input tokens using a custom parser `Result<'T, string>` function. * `arity` sets the arity of an `Option` or `Argument` @@ -782,6 +784,42 @@ Notes about invocation: +
+ Mapping to a bound set of typed values + +Use `Input.mapFromAmong` to map string inputs to typed values: + +```F# +open FSharp.SystemCommandLine +type Configuration = + | Debug + | Release + +let config = + Input.option + |> Input.mapFromAmong [ + "r", Release; "release", Release + "R", Release; "Release", Release + "d", Debug; "debug", Debug + "D", Debug; "Debug", Debug + ] + // is required unless you provide a default + +// use `Input.mapFromAmongWith` to pass a custom string comparer! + +let config = + Input.option + |> Input.mapFromAmongWith StringComparer.OrdinalIgnoreCase [ + "r", Release; "release", Release + "d", Debug; "debug", Debug + ] +``` + +Notes about overriding properties: +* `Input.tryParse` will overwrite the configuration from `.mapFromAmong` if it is used downstream. + +
+ --- ## Configuration diff --git a/src/FSharp.SystemCommandLine/Inputs.fs b/src/FSharp.SystemCommandLine/Inputs.fs index a02f338..ea5b594 100644 --- a/src/FSharp.SystemCommandLine/Inputs.fs +++ b/src/FSharp.SystemCommandLine/Inputs.fs @@ -172,7 +172,6 @@ module Input = input |> editOption (fun o -> o.Required <- true) - /// Marks an argument as required. /// When set to true, this option will be applied to its immediate parent command or commands and recursively to their subcommands. let recursive (input: ActionInput<'T>) = input @@ -308,6 +307,32 @@ module Input = argResult.AddError(err) Unchecked.defaultof<'T> ) + + + /// + /// Maps an input whose legal values are a known set bound to a typed value using the given StringComparer. + /// Caution: avoid overriding downstream with Input.tryParse. + /// + let mapFromAmongWith (comparer: StringComparer) (choices: seq) (input: ActionInput<'T>) = + let keys = choices |> Seq.map fst + let legal = keys |> String.concat ", " + let lookup token = choices |> Seq.tryFind (fun (key, _) -> comparer.Equals(key, token)) |> Option.map snd + editOption (fun opt -> for key in keys do opt.CompletionSources.Add key) input + |> editArgument (fun arg -> for key in keys do arg.CompletionSources.Add key) + // parser closes over lookup -> nothing downstream can reach in/modify or would break. + |> tryParse (fun argResult -> + match argResult.Tokens |> Seq.tryLast with + | None -> Error $"'%s{argResult.Argument.Name}' needs one of: %s{legal}" + | Some token -> + match lookup token.Value with + | Some value -> Ok value + | None -> Error $"'%s{token.Value}' is not a valid choice from: %s{legal}" + ) + + /// Maps an input whose legal values are a known set bound to a typed value. + /// Caution: avoid overriding downstream with Input.tryParse. + let mapFromAmong (choices: seq) (input: ActionInput<'T>) = + mapFromAmongWith StringComparer.Ordinal choices input /// Sets the arity of an option or argument. let arity (arity: Arity) (input: ActionInput<'T>) = diff --git a/src/Tests/MapFromAmongTest.fs b/src/Tests/MapFromAmongTest.fs new file mode 100644 index 0000000..5a0bf5d --- /dev/null +++ b/src/Tests/MapFromAmongTest.fs @@ -0,0 +1,127 @@ +module MapFromAmongTest + + +open System +open NUnit.Framework +open Swensen.Unquote +open FSharp.SystemCommandLine +open Utils +open Input + +let mutable actionCalled = false +let callAction() = actionCalled <- true +[] +let setup () = actionCalled <- false + +type DUType = + | A + | B + +let duChoices = [ + "a", A + B.ToString() (* "B" *), B +] + +[] +let ``01 - mapFromAmong requires input``() = + let input = + option "--du" |> mapFromAmong duChoices + testRootCommand "--du" { + description "Test" + inputs input + setAction (ignore >> callAction) + } <>! 0 + actionCalled <>! true + +[] +let ``02 - mapFromAmong returns correct typed DU value``() = + let input = option "--du" |> mapFromAmong duChoices + let compareAgainst (shouldSucceed: bool): string -> DUType -> unit = fun cmd v -> + testRootCommand cmd { + description "Test" + inputs input + setAction (fun o -> + if shouldSucceed + then o =! v |> callAction; 0 + else o <>! v; 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + actionCalled =! shouldSucceed + actionCalled <- false + let shouldSucceed = compareAgainst true + let shouldFail = compareAgainst false + // valid casing + shouldSucceed "--du a" A + shouldSucceed "--du B" B + // invalid casing + shouldFail "--du A" A + shouldFail "--du b" B + // invalid input + shouldFail "--du c" A + shouldFail "--du c" B + // invalid map + shouldFail "--du a" B + shouldFail "--du B" A + + +[] +let ``03 - mapFromAmongWith returns correct typed DU - case insensitive``() = + let input = option "--du" |> mapFromAmongWith StringComparer.OrdinalIgnoreCase duChoices + let compareAgainst (shouldSucceed: bool): string -> DUType -> unit = fun cmd v -> + testRootCommand cmd { + description "Test" + inputs input + setAction (fun o -> + if shouldSucceed + then o =! v |> callAction; 0 + else o <>! v; 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + actionCalled =! shouldSucceed + actionCalled <- false + let shouldSucceed = compareAgainst true + let shouldFail = compareAgainst false + shouldSucceed "--du a" A + shouldSucceed "--du A" A + shouldSucceed "--du b" B + shouldSucceed "--du B" B + // invalid input + shouldFail "--du c" A + shouldFail "--du c" B + // invalid map + shouldFail "--du a" B + shouldFail "--du B" A + +[] +let ``04 - mapFromAmong followed by different tryParse will override``() = + let input = option "--du" |> mapFromAmong duChoices |> tryParse (fun _ -> Ok A) + let compareAgainst (shouldSucceed: bool): string -> DUType -> unit = fun cmd v -> + testRootCommand cmd { + description "Test" + inputs input + setAction (fun o -> + if shouldSucceed + then o =! v |> callAction; 0 + else o <>! v; 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + actionCalled =! shouldSucceed + actionCalled <- false + let shouldSucceed = compareAgainst true + let shouldFail = compareAgainst false + shouldSucceed "--du a" A + shouldSucceed "--du A" A + shouldSucceed "--du b" A + shouldSucceed "--du B" A + shouldFail "--du a" B + shouldFail "--du A" B + shouldFail "--du b" B + shouldFail "--du B" B + // invalid input still processes + // completions will still show correctly + // undefined behaviour + shouldSucceed "--du c" A + shouldFail "--du c" B diff --git a/src/Tests/Tests.fsproj b/src/Tests/Tests.fsproj index 701f2dd..9d21195 100644 --- a/src/Tests/Tests.fsproj +++ b/src/Tests/Tests.fsproj @@ -17,6 +17,7 @@ +