feat: 4 function helpers for accepting a known set of values bound to a typed value

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:
 
 </details>
 
+<details>
+    <summary><b>Mapping to a bound set of typed values</b></summary>
+
+Use `Input.mapFromAmong` to map string inputs to typed values:
+
+```F#
+open FSharp.SystemCommandLine
+type Configuration =
+    | Debug
+    | Release
+
+let config =
+    Input.option<Configuration>
+    |> 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<Configuration>
+    |> 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.
+
+</details>
+
 ---
 
 ## Configuration

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>
         )
+
+
+    /// <summary>
+    /// Maps an input whose legal values are a known set bound to a typed value using the given <c>StringComparer</c>.
+    /// <remarks>Caution: avoid overriding downstream with <c>Input.tryParse</c>.</remarks>
+    /// </summary>
+    let mapFromAmongWith (comparer: StringComparer) (choices: seq<string * 'T>) (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}"
+            )
+
+    /// <summary>Maps an input whose legal values are a known set bound to a typed value.</summary>
+    /// <remarks>Caution: avoid overriding downstream with <c>Input.tryParse</c>.</remarks>
+    let mapFromAmong (choices: seq<string * 'T>) (input: ActionInput<'T>) =
+        mapFromAmongWith StringComparer.Ordinal choices input
 
     /// Sets the arity of an option or argument.
     let arity (arity: Arity) (input: ActionInput<'T>) =

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
+[<SetUp>]
+let setup () = actionCalled <- false
+
+type DUType =
+    | A
+    | B
+
+let duChoices = [
+    "a", A
+    B.ToString() (* "B" *), B
+]
+
+[<Test>]
+let ``01 - mapFromAmong requires input``() =
+    let input =
+        option<DUType> "--du" |> mapFromAmong duChoices
+    testRootCommand "--du" {
+        description "Test"
+        inputs input
+        setAction (ignore >> callAction)
+    } <>! 0
+    actionCalled <>! true
+
+[<Test>]
+let ``02 - mapFromAmong returns correct typed DU value``() =
+    let input = option<DUType> "--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
+
+
+[<Test>]
+let ``03 - mapFromAmongWith returns correct typed DU - case insensitive``() =
+    let input = option<DUType> "--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
+
+[<Test>]
+let ``04 - mapFromAmong followed by different tryParse will override``() =
+    let input = option<DUType> "--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

src/Tests/Tests.fsproj

@@ -17,6 +17,7 @@
     <Compile Include="SimpleAsyncTest.fs" />
     <Compile Include="SimpleAppTest.fs" />
     <Compile Include="InputBuilderTest.fs" />
+    <Compile Include="MapFromAmongTest.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>