diff --git a/src/FSharp.Data.GraphQL.Client/ReflectionPatterns.fs b/src/FSharp.Data.GraphQL.Client/ReflectionPatterns.fs index 5913fff8..55a7eadc 100644 --- a/src/FSharp.Data.GraphQL.Client/ReflectionPatterns.fs +++ b/src/FSharp.Data.GraphQL.Client/ReflectionPatterns.fs @@ -24,6 +24,13 @@ module ReflectionPatterns = let isOption (t : Type) = t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<_ option> + /// + /// Returns when is an F# voption type. + /// + /// Type to inspect. + let isValueOption (t : Type) = + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof<_ voption> + let isMap (t : Type) = t = typeof> @@ -70,49 +77,86 @@ module ReflectionPatterns = let (_, none, _) = getOptionCases t FSharpValue.MakeUnion(none, [||]) + let private getValueOptionCases (t : Type) = + let votype = typedefof<_ voption>.MakeGenericType(t) + let cases = FSharpType.GetUnionCases (votype) + let valueSome = cases |> Array.find (fun c -> c.Name = "ValueSome") + let valueNone = cases |> Array.find (fun c -> c.Name = "ValueNone") + (valueSome, valueNone, votype) + + /// + /// Builds a boxed 'T voption value: becomes ValueNone, otherwise the value is wrapped as ValueSome. + /// + let makeValueOption (t : Type) (value : obj) = + let (valueSome, valueNone, _) = getValueOptionCases t + if isNull value then + FSharpValue.MakeUnion (valueNone, [||]) + else + FSharpValue.MakeUnion (valueSome, [| value |]) + + [] let (|Option|_|) t = - if isOption t then Some (Option (t.GetGenericArguments().[0])) - else None + if isOption t then ValueSome (Option (t.GetGenericArguments().[0])) + else ValueNone + + /// + /// Matches F# voption types and extracts their generic value type. + /// + /// Type to inspect. + [] + let (|ValueOption|_|) t = + if isValueOption t then ValueSome (ValueOption (t.GetGenericArguments().[0])) + else ValueNone let isType (expected : Type) (t : Type) = match t with | Option t -> t = expected + | ValueOption t -> t = expected | _ -> t = expected let isNumericType (t : Type) = numericTypes |> Array.exists (fun expected -> isType expected t) + [] let (|Array|_|) (t : Type) = - if t.IsArray then Some (Array (t.GetElementType())) - else None + if t.IsArray then ValueSome (Array (t.GetElementType())) + else ValueNone + [] let (|List|_|) (t : Type) = - if isList t then Some (List (t.GetGenericArguments().[0])) - else None + if isList t then ValueSome (List (t.GetGenericArguments().[0])) + else ValueNone + [] let (|Seq|_|) (t : Type) = - if isSeq t then Some (Seq (t.GetGenericArguments().[0])) - else None + if isSeq t then ValueSome (Seq (t.GetGenericArguments().[0])) + else ValueNone + [] let (|EnumerableValue|_|) (x : obj) = match x with - | :? IEnumerable as x -> Some (EnumerableValue (Seq.cast x |> Array.ofSeq)) - | _ -> None + | :? IEnumerable as x -> ValueSome (EnumerableValue (Seq.cast x |> Array.ofSeq)) + | _ -> ValueNone + [] let (|OptionValue|_|) (x : obj) = let xtype = x.GetType() + let tryGetValue optionType = + match FSharpValue.GetUnionFields(x, optionType) with + | (_, [|value|]) -> ValueSome (OptionValue Some value) + | _ -> ValueSome (OptionValue None) if isOption xtype - then - match FSharpValue.GetUnionFields(x, xtype) with - | (_, [|value|]) -> Some (OptionValue Some value) - | _ -> Some (OptionValue None) - else None + then tryGetValue xtype + elif isValueOption xtype + then tryGetValue xtype + else ValueNone + [] let (|EnumValue|_|) (x : obj) = let xtype = x.GetType() if xtype.IsEnum - then Some (x.ToString()) - else None + then ValueSome (x.ToString()) + else ValueNone let makeValue (t : Type) (value : obj) = let isOption = isOption t diff --git a/src/FSharp.Data.GraphQL.Client/Serialization.fs b/src/FSharp.Data.GraphQL.Client/Serialization.fs index 6572c1aa..22fb098c 100644 --- a/src/FSharp.Data.GraphQL.Client/Serialization.fs +++ b/src/FSharp.Data.GraphQL.Client/Serialization.fs @@ -24,11 +24,13 @@ module Serialization = let private downcastNone<'T> t = match t with | Option t -> downcast (makeOption t null) + | ValueOption t -> downcast (makeValueOption t null) | _ -> failwith $"Error parsing JSON value: %O{t} is not an option value." let private downcastType (t : Type) x = match t with | Option t -> downcast (makeOption t (Convert.ChangeType(x, t))) + | ValueOption t -> downcast (makeValueOption t (Convert.ChangeType(x, t))) | _ -> downcast (Convert.ChangeType(x, t)) let private isStringType = isType typeof @@ -37,7 +39,7 @@ module Serialization = let private isUriType = isType typeof let private isGuidType = isType typeof let private isBooleanType = isType typeof - let private isEnumType = function (Option t | t) when t.IsEnum -> true | _ -> false + let private isEnumType = function (Option t | ValueOption t | t) when t.IsEnum -> true | _ -> false let private downcastString (t : Type) (s : string) = match t with @@ -60,7 +62,7 @@ module Serialization = | _ -> failwith $"Error parsing JSON value: %O{t} is a Guid type, but parsing of value \"%s{s}\" failed." | t when isEnumType t -> match t with - | (Option et | et) -> + | (Option et | ValueOption et | et) -> try Enum.Parse(et, s) |> downcastType t with _ -> failwith $"Error parsing JSON value: %O{t} is a Enum type, but parsing of value \"%s{s}\" failed." | _ -> failwith $"Error parsing JSON value: %O{t} is not a string type." @@ -92,6 +94,7 @@ module Serialization = Tracer.runAndMeasureExecutionTime "Converted Array JsonValue to CLR array" (fun _ -> match t with | Option t -> getArrayValue t converter items |> makeOption t + | ValueOption t -> getArrayValue t converter items |> makeValueOption t | Array itype | Seq itype -> items |> Array.map (converter itype) |> castArray itype | List itype -> items |> Array.map (converter itype) |> Array.toList |> castList itype | _ -> failwith $"Error parsing JSON value: %O{t} is not an array type.") @@ -121,9 +124,12 @@ module Serialization = |> Array.map (fun (n, t) -> match Map.tryFind n jprops with | Some p -> n, convert t p - | None -> n, makeOption t null) + | None -> + match t with + | ValueOption vt -> n, makeValueOption vt null + | _ -> n, makeOption t null) let rcrd = - let t = match t with Option t -> t | _ -> t + let t = match t with Option t | ValueOption t -> t | _ -> t let vals = vals t if isMap t then Map.ofArray vals |> box diff --git a/src/FSharp.Data.GraphQL.Client/TextConversions.fs b/src/FSharp.Data.GraphQL.Client/TextConversions.fs index 3a2dd6b5..2bd51238 100644 --- a/src/FSharp.Data.GraphQL.Client/TextConversions.fs +++ b/src/FSharp.Data.GraphQL.Client/TextConversions.fs @@ -16,12 +16,14 @@ open System.Text.RegularExpressions module private TextConversionHelpers = let asOption = function true, v -> Some v | _ -> None + [] let (|StringEqualsIgnoreCase|_|) (s1:string) s2 = if s1.Equals(s2, StringComparison.OrdinalIgnoreCase) - then Some () else None + then ValueSome () else ValueNone + [] let (|OneOfIgnoreCase|_|) set str = - if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then Some() else None + if Array.exists (fun s -> StringComparer.OrdinalIgnoreCase.Compare(s, str) = 0) set then ValueSome() else ValueNone let msDateRegex = lazy Regex(@"^/Date\((-?\d+)([-+]\d+)?\)/$", RegexOptions.Compiled) diff --git a/src/FSharp.Data.GraphQL.Server.AspNetCore/GraphQLWebsocketMiddleware.fs b/src/FSharp.Data.GraphQL.Server.AspNetCore/GraphQLWebsocketMiddleware.fs index 2677f9d4..d399a879 100644 --- a/src/FSharp.Data.GraphQL.Server.AspNetCore/GraphQLWebsocketMiddleware.fs +++ b/src/FSharp.Data.GraphQL.Server.AspNetCore/GraphQLWebsocketMiddleware.fs @@ -51,10 +51,11 @@ module internal IncrementalPayloadSplitting = /// Matches a path ending in a list of indices, such as the path of a batched deferred payload, returning the /// path of the batch's own field and the indices of its items. + [] let (|BatchPath|_|) (path : obj list) = match List.rev path with - | (:? (obj list) as indices) :: fieldPathRev -> Some (List.rev fieldPathRev, indices) - | _ -> None + | (:? (obj list) as indices) :: fieldPathRev -> ValueSome (List.rev fieldPathRev, indices) + | _ -> ValueNone /// Splits a batch's data (an array with one element per index, in the same order) and errors (each carrying the /// full path of the item it belongs to, since every error of a batch originates from resolving one specific diff --git a/src/FSharp.Data.GraphQL.Server/Execution.fs b/src/FSharp.Data.GraphQL.Server/Execution.fs index 441dc5d2..f9a5fc7f 100644 --- a/src/FSharp.Data.GraphQL.Server/Execution.fs +++ b/src/FSharp.Data.GraphQL.Server/Execution.fs @@ -412,8 +412,8 @@ and private executeResolvers (inputContext : InputExecutionContextProvider) (ctx let rec innerListDef = function | Nullable (Output innerDef) -> innerListDef innerDef - | List (Output innerDef) -> Some innerDef - | _ -> None + | List (Output innerDef) -> ValueSome innerDef + | _ -> ValueNone let (|HasList|_|) = innerListDef diff --git a/src/FSharp.Data.GraphQL.Server/ObservableExtensions.fs b/src/FSharp.Data.GraphQL.Server/ObservableExtensions.fs index f8335151..d1063fa9 100644 --- a/src/FSharp.Data.GraphQL.Server/ObservableExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server/ObservableExtensions.fs @@ -65,10 +65,11 @@ module internal Observable = /// Distinguishes a linked-token cancellation, typically caused by a resolution failure, from the /// subscription itself being disposed. /// + [] let (|CanceledIndependently|_|) (cancellationToken : CancellationToken) (ex : exn) = match ex with - | :? OperationCanceledException when not cancellationToken.IsCancellationRequested -> Some () - | _ -> None + | :? OperationCanceledException when not cancellationToken.IsCancellationRequested -> ValueSome () + | _ -> ValueNone /// /// Creates a cold observable, which enumerates the asynchronous sequence for every subscription. diff --git a/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs b/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs index 69815c29..be3e998a 100644 --- a/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs +++ b/src/FSharp.Data.GraphQL.Server/ReflectionHelper.fs @@ -24,40 +24,46 @@ type internal Methods = module internal Gen = + [] let (|List|_|) (t: Type) = let typeParam = t.GetGenericArguments().[0] let tList = typedefof<_ list>.MakeGenericType [| typeParam |] - if t = tList then Some typeParam - else None + if t = tList then ValueSome typeParam + else ValueNone + [] let (|Array|_|) (t: Type) = - if t.IsArray then Some (t.GetGenericArguments().[0]) - else None + if t.IsArray then ValueSome (t.GetGenericArguments().[0]) + else ValueNone + [] let (|Set|_|) (t: Type) = let typeParam = t.GetGenericArguments().[0] let tArray = typedefof>.MakeGenericType [| typeParam |] - if t = tArray then Some typeParam - else None + if t = tArray then ValueSome typeParam + else ValueNone let inline defaultArgOnNull a b = if isNull a |> not then a else b let private optionType = typedefof> + [] let (|Option|_|) (t: Type) = if t.IsGenericType && t.GetGenericTypeDefinition() = optionType - then Some (t.GetGenericArguments().[0]) - else None + then ValueSome (t.GetGenericArguments().[0]) + else ValueNone + [] let (|Enumerable|_|) t = if typeof.IsAssignableFrom t then let e = defaultArgOnNull (t.GetInterface("IEnumerable`1")) t - Some (e.GetGenericArguments().[0]) - else None + ValueSome (e.GetGenericArguments().[0]) + else ValueNone + [] let (|Queryable|_|) t = if typeof.IsAssignableFrom t - then Some (Queryable (t.GetInterface("IQueryable`1").GetGenericArguments().[0])) - else None + then ValueSome (Queryable (t.GetInterface("IQueryable`1").GetGenericArguments().[0])) + else ValueNone let genericType<'t> typeParams = typedefof<'t>.MakeGenericType typeParams diff --git a/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs b/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs index d8dcac5d..fcf416ae 100644 --- a/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs +++ b/src/FSharp.Data.GraphQL.Shared/AsyncVal.fs @@ -230,10 +230,12 @@ module AsyncExtensions = let asyncVal = AsyncValBuilder () /// Active pattern used for checking if AsyncVal contains immediate value. - let (|Immediate|_|) (x : AsyncVal<'T>) = match x with | Value v -> Some v | _ -> None + [] + let (|Immediate|_|) (x : AsyncVal<'T>) = match x with | Value v -> ValueSome v | _ -> ValueNone /// Active patter used for checking if AsyncVal wraps an Async computation. - let (|Async|_|) (x : AsyncVal<'T>) = match x with | Async a -> Some a | _ -> None + [] + let (|Async|_|) (x : AsyncVal<'T>) = match x with | Async a -> ValueSome a | _ -> ValueNone type Microsoft.FSharp.Control.AsyncBuilder with diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/Reflection.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/Reflection.fs index d160e1ef..5c43063c 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/Reflection.fs +++ b/src/FSharp.Data.GraphQL.Shared/Helpers/Reflection.fs @@ -171,28 +171,31 @@ module Helpers = let rec internal moduleType = ReflectionHelper.getModuleType <@ moduleType @> - /// - /// Casts a to a . - /// - let optionCast (value: obj) = - if isNull value then None + let private objectOptionCast (value: obj) = + if isNull value then ValueNone else let t = value.GetType() if t.FullName.StartsWith ReflectionHelper.OptionTypeName then let p = t.GetProperty("Value") - Some (p.GetValue(value, [||])) + ValueSome (p.GetValue(value, [||])) elif t.FullName.StartsWith ReflectionHelper.ValueOptionTypeName then - if value = Activator.CreateInstance t then None + if value = Activator.CreateInstance t then ValueNone else let p = t.GetProperty("Value") - Some (p.GetValue(value, [||])) - else None + ValueSome (p.GetValue(value, [||])) + else ValueNone + + /// + /// Casts a to a . + /// + let optionCast (value: obj) = objectOptionCast value |> ValueOption.toOption /// - /// Matches a System.Object with an option. - /// If the object is an . + /// Matches a containing a boxed or . + /// Returns the wrapped value for and , and does not match for , , or non-option values. /// - let (|ObjectOption|_|) = optionCast + [] + let (|ObjectOption|_|) (value : obj) = objectOptionCast value /// /// Lifts a to an , unless it is already an . diff --git a/src/FSharp.Data.GraphQL.Shared/Output.fs b/src/FSharp.Data.GraphQL.Shared/Output.fs index de048a55..1f706fff 100644 --- a/src/FSharp.Data.GraphQL.Shared/Output.fs +++ b/src/FSharp.Data.GraphQL.Shared/Output.fs @@ -23,10 +23,11 @@ type NameValueLookup(keyValues: KeyValuePair []) = else i <- i+1 let getValue key = (kvals |> Array.find (fun kv -> kv.Key = key)).Value + [] let (|BoxedSeq|_|) (xs : obj) = match xs with - | (:? System.Collections.IEnumerable as enumerable) -> Some (Seq.cast enumerable) - | _ -> None + | (:? System.Collections.IEnumerable as enumerable) -> ValueSome (Seq.cast enumerable) + | _ -> ValueNone let rec structEq (x: NameValueLookup) (y: NameValueLookup) = if Object.ReferenceEquals(x, y) then true diff --git a/src/FSharp.Data.GraphQL.Shared/SchemaDefinitions.fs b/src/FSharp.Data.GraphQL.Shared/SchemaDefinitions.fs index 08ff47d0..b67a642c 100644 --- a/src/FSharp.Data.GraphQL.Shared/SchemaDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Shared/SchemaDefinitions.fs @@ -183,13 +183,14 @@ module SchemaDefinitions = | other -> None /// Check if provided obj value is an Option and extract its wrapped value as object if possible + [] let private (|Option|_|) (x : obj) = - if isNull x then None + if isNull x then ValueNone else let t = x.GetType().GetTypeInfo() if t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> then - t.GetDeclaredProperty("Value").GetValue(x) |> Some - else None + t.GetDeclaredProperty("Value").GetValue(x) |> ValueSome + else ValueNone /// Tries to convert any value to string. let coerceStringValue (x : obj) : string option = diff --git a/src/FSharp.Data.GraphQL.Shared/TypeSystem.fs b/src/FSharp.Data.GraphQL.Shared/TypeSystem.fs index c8d81d01..2ac61474 100644 --- a/src/FSharp.Data.GraphQL.Shared/TypeSystem.fs +++ b/src/FSharp.Data.GraphQL.Shared/TypeSystem.fs @@ -2405,39 +2405,43 @@ module Resolve = class end + [] let private (|FSharpFunc|_|) (typ : Type) = if FSharpType.IsFunction typ then let d, c = FSharpType.GetFunctionElements typ - Some (d, c) + ValueSome (d, c) else - None + ValueNone + [] let private (|FSharpOption|_|) (typ : Type) = if typ.GetTypeInfo().IsGenericType && typ.GetGenericTypeDefinition () = typedefof> then - Some (typ.GenericTypeArguments |> Array.head) + ValueSome (typ.GenericTypeArguments |> Array.head) else - None + ValueNone + [] let private (|FSharpAsync|_|) (typ : Type) = if typ.GetTypeInfo().IsGenericType && typ.GetGenericTypeDefinition () = typedefof> then - Some (typ.GenericTypeArguments |> Array.head) + ValueSome (typ.GenericTypeArguments |> Array.head) else - None + ValueNone + [] let private (|AsyncEnumerable|_|) (typ : Type) = if typ.GetTypeInfo().IsGenericType && typ.GetGenericTypeDefinition () = typedefof> then - Some (typ.GenericTypeArguments |> Array.head) + ValueSome (typ.GenericTypeArguments |> Array.head) else - None + ValueNone let private boxify<'T, 'U> (f : ResolveFieldContext -> 'T -> 'U) : ResolveFieldContext -> obj -> obj = <@@ fun ctx (x : obj) -> f ctx (x :?> 'T) |> box @@>