Inferred router: support ValueOption as optional query parameter

fsbolero · Aug 20, 2023 · b00aa64 · b00aa64
1 parent 425793f
commit b00aa64
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 17 deletions.
diff --git a/src/Bolero/Router.fs b/src/Bolero/Router.fs
@@ -250,22 +250,31 @@ module private RouterImpl =
             k, singleSegmentSerializer s
     ]
 
-    let getSingleSerializer (ty: Type) : SingleSerializer * bool =
+    let getSingleSerializer (ty: Type) : SingleSerializer * obj voption =
         match baseTypeSingleSerializers.TryGetValue(ty) with
-        | true, s -> s, false
+        | true, s -> s, ValueNone
         | false, _ ->
-            if ty.IsGenericType && ty.GetGenericTypeDefinition() = typedefof<option<_>> then
+            if ty.IsGenericType &&
+               (let gen = ty.GetGenericTypeDefinition()
+                gen = typedefof<option<_>> || gen = typedefof<voption<_>>)
+            then
                 match baseTypeSingleSerializers.TryGetValue(ty.GetGenericArguments()[0]) with
                 | true, s ->
-                    let someCase = FSharpType.GetUnionCases(ty)[1]
+                    let cases = FSharpType.GetUnionCases(ty)
+                    let noneCase = cases[0]
+                    let someCase = cases[1]
                     let someCtor = FSharpValue.PreComputeUnionConstructor(someCase)
                     let someDector = FSharpValue.PreComputeUnionReader(someCase)
+                    let none = FSharpValue.MakeUnion(noneCase, Array.empty)
+                    let getTag = FSharpValue.PreComputeUnionTagReader(ty)
                     {
                         parse = s.parse >> Option.map (fun x -> someCtor [|x|])
-                        write = function
-                            | null -> None
-                            | x -> s.write (someDector x).[0]
-                    }, true
+                        write = fun x ->
+                            if getTag x = 0 then
+                                None
+                            else
+                                s.write (someDector x).[0]
+                    }, ValueSome none
                 | false, _ -> fail (InvalidRouterKind.UnsupportedType ty)
             else
                 fail (InvalidRouterKind.UnsupportedType ty)
@@ -381,7 +390,7 @@ module private RouterImpl =
         {
             index: int
             serializer: SingleSerializer
-            isOptional: bool
+            optionalDefaultValue: obj voption
             name: string
             propName: string
         }
@@ -511,11 +520,11 @@ module private RouterImpl =
                 |> Array.tryFindIndex (fun f -> f.Name = propName)
                 |> Option.defaultWith(fun () -> fail (InvalidRouterKind.UnknownField(case, propName)))
             let prop = fields[index]
-            let serializer, isOptional = getSingleSerializer prop.PropertyType
+            let serializer, optionalDefaultValue = getSingleSerializer prop.PropertyType
             {
                 index = index
                 serializer = serializer
-                isOptional = isOptional
+                optionalDefaultValue = optionalDefaultValue
                 name = paramName
                 propName = propName
             })
@@ -643,13 +652,18 @@ module private RouterImpl =
                             case.query
                             |> List.forall (fun p ->
                                 match Map.tryFind p.name query with
-                                | None -> p.isOptional
+                                | None ->
+                                    match p.optionalDefaultValue with
+                                    | ValueSome def ->
+                                        args[p.index] <- def
+                                        true
+                                    | ValueNone -> false
                                 | Some v ->
                                     match p.serializer.parse v with
                                     | Some x ->
                                         args[p.index] <- x
                                         true
-                                    | _ -> false)
+                                    | None -> false)
                         if allQueryParamsAreHere then
                             Some (case.ctor args, rest)
                         else None)

diff --git a/tests/Unit.Client/Routing.fs b/tests/Unit.Client/Routing.fs
@@ -47,7 +47,7 @@ type Page =
     | [<EndPoint "/with-rest-array/{*rest}">] WithRestArray of rest: (int * string)[]
     | [<EndPoint "/with-model">] WithModel of PageModel<int>
     | [<EndPoint "/with-model-args/{arg}">] WithModelAndArgs of arg: int * PageModel<string>
-    | [<EndPoint "/with-query/{arg}?named={n}&{implicit}&{optional}">] WithQuery of arg: int * n: int * implicit: int * optional: int option
+    | [<EndPoint "/with-query/{arg}?named={n}&{implicit}&{optional}&{voptional}">] WithQuery of arg: int * n: int * implicit: int * optional: int option * voptional: int voption
 
 and InnerPage =
     | [<EndPoint "/">] InnerHome
@@ -114,7 +114,7 @@ let rec pageClass = function
     | WithRestArray a -> $"""withrestarray-{a |> Seq.map (fun (i, s) -> $"{i}-{s}") |> String.concat "-"}"""
     | WithModel _ -> "withmodel"
     | WithModelAndArgs (a, _) -> $"withmodelargs-{a}"
-    | WithQuery(a, b, c, d) -> $"withquery-{a}-{b}-{c}-{d}"
+    | WithQuery(a, b, c, d, e) -> $"withquery-{a}-{b}-{c}-{d}-{e}"
 
 let innerlinks =
     [
@@ -166,8 +166,8 @@ let baseLinks =
             "/with-rest-array/1/foo/2/bar",     WithRestArray [|(1, "foo"); (2, "bar")|]
             "/with-model",                      WithModel { Model = Unchecked.defaultof<_> }
             "/with-model-args/42",              WithModelAndArgs(42, { Model = Unchecked.defaultof<_> })
-            "/with-query/42?implicit=2&named=1&optional=3", WithQuery(42, 1, 2, Some 3)
-            "/with-query/42?implicit=5&named=4", WithQuery(42, 4, 5, None)
+            "/with-query/42?implicit=2&named=1&optional=3", WithQuery(42, 1, 2, Some 3, ValueNone)
+            "/with-query/42?implicit=5&named=4&voptional=3", WithQuery(42, 4, 5, None, ValueSome 3)
         ]
         for link, page in innerlinks do
             yield "/with-union" + link,                     WithUnion page