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