diff --git a/src/FSharp.SystemCommandLine/Inputs.fs b/src/FSharp.SystemCommandLine/Inputs.fs index 289d499..6b1f27e 100644 --- a/src/FSharp.SystemCommandLine/Inputs.fs +++ b/src/FSharp.SystemCommandLine/Inputs.fs @@ -3,15 +3,93 @@ namespace FSharp.SystemCommandLine open System open System.CommandLine -module private MaybeParser = +module private MaybeParser = + /// Parses an argument token value to the given type. + let parseTokenValueForType (typ: Type) (tokenValue: string) = + match typ with + | t when t = typeof -> IO.DirectoryInfo(tokenValue) :> obj + | t when t = typeof -> IO.FileInfo(tokenValue) + | t when t = typeof -> Uri(tokenValue) + | t -> Convert.ChangeType(tokenValue, t) + /// Parses an argument token value. /// TODO: Ideally, this should use the S.CL Arugment parser. let parseTokenValue<'T> (tokenValue: string) = - match typeof<'T> with - | t when t = typeof -> IO.DirectoryInfo(tokenValue) |> unbox<'T> |> Some - | t when t = typeof -> IO.FileInfo(tokenValue) |> unbox<'T> |> Some - | t when t = typeof -> Uri(tokenValue) |> unbox<'T> |> Some - | t -> Convert.ChangeType(tokenValue, t) :?> 'T |> Some + parseTokenValueForType typeof<'T> tokenValue :?> 'T |> Some + +/// Short alias used in SafeInputLists for constraints and delegate construction. +type private ParseFunc<'T> = Func +type private SafeInputLists = + // bound generic `List.OfArray` method + static let ofArrayInfo = + typeof> + .Assembly + .GetType("Microsoft.FSharp.Collections.ListModule") + .GetMethod("OfArray", System.Reflection.BindingFlags.Static ||| System.Reflection.BindingFlags.Public) + // invokes `List.OfArray` with the given array using the provided type as the element type + static let ofArrayForType (typ: Type) (elements: Array) = + ofArrayInfo.MakeGenericMethod(typ.GetGenericArguments()[0]).Invoke(null, [| elements |]) + // safely retrieves the element type of a list type + static let listElementType (typ: Type) = + // naive tests show more predictable behaviour + // with the presence of this branch + match typ.GetElementType() with + | null -> typ.GetGenericArguments()[0] + | typ -> typ + // retrieves the `List.Empty` property for the given element type generic + static let makeEmptyList (typ: Type) = + match typ.GetProperty("Empty", System.Reflection.BindingFlags.Static ||| System.Reflection.BindingFlags.Public) with + | null -> Error $"Could not find Empty property on type %s{typ.FullName}." + | prop -> prop.GetValue(null) |> Ok + // determines whether provided type is a generic `list` type + static let isListGeneric (typ: Type) = + typ.IsGenericType + && typ.GetGenericTypeDefinition() = typedefof> + static member inline private dynamicParser<^T, ^U + // static binding of Option<_> and Argument<_> + // where T is the typar for U: the generic Option/Argument + when ^U:(member set_DefaultValueFactory: ParseFunc<^T> -> unit) + and ^U:(member set_CustomParser: ParseFunc<^T> -> unit) + and ^U:(member set_Arity: ArgumentArity -> unit)> + (o: ^U) = + let typ = typeof<'T> + // if not a list, noop + if not <| isListGeneric typ then () else + let elementType = listElementType typ + // parses token to element type + let changeType: Parsing.Token -> obj = + let fn = MaybeParser.parseTokenValueForType elementType + _.Value >> fn + // converts array to final list type + let ofArray = ofArrayForType typ + let empty = makeEmptyList typ + // Default Value Factory -> List.Empty + ParseFunc(fun result -> + match empty with + | Error err -> + result.AddError err + Unchecked.defaultof<'T> + | Ok empty -> empty |> unbox<'T>) + |> o.set_DefaultValueFactory + // Custom Parser -> tokens -> Array -> List.OfArray + ParseFunc(fun result -> + let count = result.Tokens.Count + let dynamicArray = Array.CreateInstance(elementType, count) + for i, token in result.Tokens |> Seq.indexed do + try + dynamicArray.SetValue(changeType token, i) + // should this be more permissive? + with :? FormatException as e -> result.AddError e.Message + ofArray dynamicArray |> unbox<'T>) + |> o.set_CustomParser + ArgumentArity(0, 100_000) + |> o.set_Arity + /// Checks `'T` for a `List<_>` generic type. Injects list compatible CustomParser and DefaultValueFactory + /// if `true`; noop if `false` + static member protect<'T>(o: Argument<'T>) = SafeInputLists.dynamicParser<'T, _> o; o + /// Checks `'T` for a `List<_>` generic type. Injects list compatible CustomParser and DefaultValueFactory + /// if `true`; noop if `false` + static member protect<'T>(o: Option<'T>) = SafeInputLists.dynamicParser<'T, _> o; o /// A custom action context that contains the `ParseResult` and a cancellation token. type ActionContext = @@ -101,7 +179,9 @@ module Input = /// Creates a named option. Example: `option "--file-name"` let option<'T> (name: string) = - Option<'T>(name) |> ActionInput.OfOption + Option<'T>(name) + |> SafeInputLists.protect + |> ActionInput.OfOption /// Edits the underlying System.CommandLine.Option<'T>. let editOption (edit: Option<'T> -> unit) (input: ActionInput<'T>) = @@ -216,8 +296,9 @@ module Input = /// Creates a named argument. Example: `argument "file-name"` let argument<'T> (name: string) = - let a = Argument<'T>(name) - ActionInput.OfArgument<'T> a + Argument<'T>(name) + |> SafeInputLists.protect + |> ActionInput.OfArgument<'T> /// Creates a named argument of type `Argument<'T option>` that defaults to `None`. let argumentMaybe<'T> (name: string) = diff --git a/src/Tests/ListOptionTest.fs b/src/Tests/ListOptionTest.fs new file mode 100644 index 0000000..eb442de --- /dev/null +++ b/src/Tests/ListOptionTest.fs @@ -0,0 +1,102 @@ +module ListOptionTest + + +open NUnit.Framework +open Swensen.Unquote +open FSharp.SystemCommandLine +open Utils +open Input + +let mutable handlerCalled = false +let called() = handlerCalled <- true +[] +let setup () = handlerCalled <- false + +[] +let ``01 - No input to string list option should be empty list``() = + let input = option "-p" + let commandRunner (shouldSucceed: bool): string -> (string list -> bool) -> unit = fun command comp -> + testRootCommand command { + description "Test" + inputs input + setAction (function + | values when comp values -> called(); 0 + | _ -> 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + handlerCalled =! shouldSucceed + handlerCalled <- false + let shouldSucceed = commandRunner true + let shouldFail = commandRunner false + + shouldSucceed "" List.isEmpty + shouldSucceed "-p a" (List.isEmpty >> not) + shouldFail "-p a" List.isEmpty + +[] +let ``02 - No input to int list option should be empty list``() = + let input = option "-p" + let commandRunner (shouldSucceed: bool): string -> (int list -> bool) -> unit = fun command comp -> + testRootCommand command { + description "Test" + inputs input + setAction (function + | values when comp values -> called(); 0 + | _ -> 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + handlerCalled =! shouldSucceed + handlerCalled <- false + let shouldSucceed = commandRunner true + let shouldFail = commandRunner false + + shouldSucceed "" List.isEmpty + shouldSucceed "-p 3" (List.isEmpty >> not) + shouldFail "-p a" List.isEmpty + + +[] +let ``03 - No input to string list argument should be empty list``() = + let input = argument "p" + let commandRunner (shouldSucceed: bool): string -> (string list -> bool) -> unit = fun command comp -> + testRootCommand command { + description "Test" + inputs input + setAction (function + | values when comp values -> called(); 0 + | _ -> 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + handlerCalled =! shouldSucceed + handlerCalled <- false + let shouldSucceed = commandRunner true + let shouldFail = commandRunner false + + shouldSucceed "" List.isEmpty + shouldSucceed "a" (List.isEmpty >> not) + shouldFail "a" List.isEmpty + +[] +let ``04 - No input to int list argument should be empty list``() = + let input = argument "p" + let commandRunner (shouldSucceed: bool): string -> (int list -> bool) -> unit = fun command comp -> + testRootCommand command { + description "Test" + inputs input + setAction (function + | values when comp values -> called(); 0 + | _ -> 1 + ) + } + |> if shouldSucceed then (=!) 0 else (<>!) 0 + handlerCalled =! shouldSucceed + handlerCalled <- false + let shouldSucceed = commandRunner true + let shouldFail = commandRunner false + + shouldSucceed "" List.isEmpty + shouldSucceed "3" (List.isEmpty >> not) + shouldFail "a" List.isEmpty diff --git a/src/Tests/Tests.fsproj b/src/Tests/Tests.fsproj index 9d21195..d7700c0 100644 --- a/src/Tests/Tests.fsproj +++ b/src/Tests/Tests.fsproj @@ -18,6 +18,7 @@ +