From 143d46cca3825f17bd53296d8fcd3c4ffcd270e8 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Wed, 8 Jul 2026 19:58:06 +0200 Subject: [PATCH 01/10] Refactored `ObjectListFilter`: modularized, added type coercion - Moved filter operators and LINQ logic to ObjectListFilterModule.fs - Added `TypeCoercion.fs` for automatic filter value coercion (`Guid`, `DateTime`, F# DUs, etc.) - Introduced `FilterValueCoercer` and extended `ObjectListFilterLinqOptions` for custom coercion - Centralized filter suffix constants in `FilterSuffixConstants.fs` - Updated `SchemaDefinitions.fs` to use new suffix constants - Added `vtryFind` and `vtryPick` utilities for arrays/lists in `Extensions.fs` - Improved code style, documentation, and function signatures --- ...harp.Data.GraphQL.Server.Middleware.fsproj | 3 + .../ObjectListFilter.fs | 424 ++---------------- .../ObjectListFilterModule.fs | 422 +++++++++++++++++ .../SchemaDefinitions.fs | 1 - .../TypeCoercion.fs | 298 ++++++++++++ .../TypeSystemExtensions.fs | 2 - .../Helpers/Extensions.fs | 58 +++ 7 files changed, 814 insertions(+), 394 deletions(-) create mode 100644 src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs create mode 100644 src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj index 9eddcf46f..7ceaefb05 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj +++ b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj @@ -20,8 +20,11 @@ + + + diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index bb4f80e47..607ed0392 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -7,7 +7,6 @@ open FSharp.Data.GraphQL /// A filter definition for a field value. type FieldFilter<'Val> = { FieldName : string; Value : 'Val } -/// /// A filter definition for an object list. /// /// @@ -34,52 +33,40 @@ type ObjectListFilter = | OfTypes of Type list | FilterField of FieldFilter -open System.Linq +open System.Collections.Generic open System.Linq.Expressions open System.Runtime.InteropServices -open System.Reflection -open System.Collections.Generic type private CompareDiscriminatorExpression<'T, 'D> = Expression> /// -/// Allows to specify discriminator comparison or discriminator getter -/// and a function that return discriminator value depending on entity type +/// Validation error raised when an incoming cannot be +/// translated to a LINQ expression against the queried entity type. +/// +type ObjectListFilterValidationException (message : string, [] extensions : Dictionary | null) = + inherit GQLMessageExceptionBase (ErrorKind.Validation, message, extensions) + +/// +/// Function signature for custom value coercion logic. Takes a target CLR type and a JSON +/// primitive value, returns the coerced value or if coercion is not supported. +/// +type FilterValueCoercer = Type -> obj -> obj voption + +/// +/// Optional configuration for LINQ translation including discriminator handling. /// -/// -/// // discriminator custom condition -/// let result () = -/// queryable.Apply( -/// filter, -/// ObjectListFilterLinqOptions ( -/// (fun entity discriminator -> entity.Discriminator.StartsWith discriminator), -/// (function -/// | t when Type.(=)(t, typeof) -> "cat+v1" -/// | t when Type.(=)(t, typeof) -> "dog+v1") -/// ) -/// ) -/// -/// -/// // discriminator equals -/// let result () = -/// queryable.Apply( -/// filter, -/// ObjectListFilterLinqOptions ( -/// (fun entity -> entity.Discriminator), -/// (function -/// | t when Type.(=)(t, typeof) -> "cat" -/// | t when Type.(=)(t, typeof) -> "dog") -/// ) -/// ) -/// -[] type ObjectListFilterLinqOptions<'T, 'D> - ([] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, [] getDiscriminatorValue : (Type -> 'D) | null) = + ( + [] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, + [] getDiscriminatorValue : (Type -> 'D) | null, + [] customCoercers : FilterValueCoercer list | null + ) = member _.CompareDiscriminator = compareDiscriminator |> ValueOption.ofObj member _.GetDiscriminatorValue = getDiscriminatorValue |> ValueOption.ofObj + member _.CustomCoercers = customCoercers |> Option.ofObj |> Option.defaultValue [] - static member None = ObjectListFilterLinqOptions<'T, 'D> (null, null) + static member None = ObjectListFilterLinqOptions<'T, 'D> (null, null, null) static member GetCompareDiscriminator (getDiscriminatorValue : Expression>) = let tParam = Expression.Parameter (typeof<'T>, "x") @@ -88,362 +75,17 @@ type ObjectListFilterLinqOptions<'T, 'D> Expression.Lambda> (body, tParam, dParam) new (getDiscriminator : Expression>) = - ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null) - new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>) = ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null) + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, null) + new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>) = + ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, null) new (getDiscriminatorValue : Type -> 'D) = - ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator = null, getDiscriminatorValue = getDiscriminatorValue) + ObjectListFilterLinqOptions<'T, 'D> (null, getDiscriminatorValue, null) new (getDiscriminator : Expression>, getDiscriminatorValue : Type -> 'D) = - ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, getDiscriminatorValue) - -/// Contains tooling for working with ObjectListFilter. -module ObjectListFilter = - /// Contains operators for building and comparing ObjectListFilter values. - module Operators = - /// Creates a new ObjectListFilter representing an AND operation between two existing ones. - let ( &&& ) x y = And (x, y) - - /// Creates a new ObjectListFilter representing an OR operation between two existing ones. - let ( ||| ) x y = Or (x, y) - - /// Creates a new ObjectListFilter representing an EQUALS operation between two comparable values. - let ( === ) fname value = Equals ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a GREATER THAN operation of a comparable value. - let ( >>> ) fname value = GreaterThan { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a GREATER THAN OR EQUAL operation of a comparable value. - let ( ==> ) fname value = GreaterThanOrEqual { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a LESS THAN operation of a comparable value. - let ( <<< ) fname value = LessThan { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a LESS THAN OR EQUAL operation of a comparable value. - let ( <== ) fname value = LessThanOrEqual { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a STARTS WITH operation of a string value. - let ( =@@ ) fname value = StartsWith ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing an ENDS WITH operation of a string value. - let ( @@= ) fname value = EndsWith ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a CONTAINS operation. - let ( @=@ ) fname value = Contains ({ FieldName = fname; Value = value }, null) - - /// Creates a new ObjectListFilter representing a IN operation. - let ( =~= ) fname value = In { FieldName = fname; Value = value } - - /// Creates a new ObjectListFilter representing a field sub comparison. - let ( --> ) fname filter = FilterField { FieldName = fname; Value = filter } - - /// Creates a new ObjectListFilter representing a NOT operation for the existing one. - let ( !!! ) filter = Not filter - - /// Creates a new ObjectListFilter representing a case-insensitive EQUALS operation on a string value. - let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive STARTS WITH operation on a string value. - let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive ENDS WITH operation on a string value. - let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - /// Creates a new ObjectListFilter representing a case-insensitive CONTAINS operation on a string value. - let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) - - let private genericWhereMethod = - typeof.GetMethods () - |> Seq.where (fun m -> m.Name = "Where") - |> Seq.find (fun m -> - let parameters = m.GetParameters () - parameters.Length = 2 - && parameters[1].ParameterType.GetGenericTypeDefinition () = typedefof>>) - - // Helper to create Where expression - let whereExpr<'T> (query : IQueryable<'T>) (param : ParameterExpression) predicate = - let whereMethod = genericWhereMethod.MakeGenericMethod ([| typeof<'T> |]) - Expression.Call (whereMethod, [| query.Expression; Expression.Lambda> (predicate, param) |]) - - let private objectType = typeof - let private stringType = typeof - let private genericIEnumerableType = typedefof> - - let private stringComparisonType = typeof - let private StringStartsWithMethod = stringType.GetMethod ("StartsWith", [| stringType; stringComparisonType |]) - let private StringEndsWithMethod = stringType.GetMethod ("EndsWith", [| stringType; stringComparisonType |]) - let private StringContainsMethod = stringType.GetMethod ("Contains", [| stringType; stringComparisonType |]) - let private StringEqualsMethod = stringType.GetMethod ("Equals", [| stringType; stringComparisonType |]) - let private unwrapOptionMethod = - FSharp.Data.GraphQL.Helpers.moduleType.GetMethod (nameof Helpers.unwrap) - - let private getCollectionInstanceContainsMethod (memberType : Type) = - memberType - .GetMethods(BindingFlags.Instance ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 1) - |> ValueOption.ofObj - - let private getEnumerableContainsMethod (itemType : Type) = - match - typeof - .GetMethods(BindingFlags.Static ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 2) - with - | null -> raise (MissingMemberException "Static 'Contains' method with 2 parameters not found on 'Enumerable' class") - | containsGenericStaticMethod -> containsGenericStaticMethod.MakeGenericMethod ([| itemType |]) - - let private getEnumerableCastMethod (itemType : Type) = - match - typeof - .GetMethods(BindingFlags.Static ||| BindingFlags.Public) - .FirstOrDefault (fun m -> m.Name = "Cast" && m.GetParameters().Length = 1) - with - | null -> raise (MissingMemberException "Static 'Cast' method with 1 parameter not found on 'Enumerable' class") - | castGenericStaticMethod -> castGenericStaticMethod.MakeGenericMethod ([| itemType |]) - - let getField (param : ParameterExpression) fieldName = Expression.PropertyOrField (param, fieldName) - - let hasEqualityOperator (``type`` : Type) = - ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) - |> Seq.exists (fun m -> m.Name = " op_Equality") - - let hasInequalityOperator (``type`` : Type) = - ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) - |> Seq.exists (fun m -> m.Name = "op_Inequality") - - [] - type SourceExpression private (expression : Expression) = - new (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) - new (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) - member _.Value = expression - static member op_Implicit (source : SourceExpression) = source.Value - static member op_Implicit (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) - static member op_Implicit (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) - - let equalsMethod = - objectType - |> _.GetMethods(BindingFlags.Instance ||| BindingFlags.Public) - |> Seq.where (fun m -> m.Name = "Equals") - |> Seq.head - - let staticEqualsMethod = - objectType - |> _.GetMethods(BindingFlags.Static ||| BindingFlags.Public) - |> Seq.where (fun m -> m.Name = "Equals") - |> Seq.head - - /// Maps an IComparer to a StringComparison value. - /// Returns ValueNone only when the comparer is null or is not a recognized StringComparer. - let private comparerToStringComparison (comparer : IComparer) = - match comparer with - | null -> ValueNone - | :? StringComparer as sc -> - if obj.ReferenceEquals (sc, StringComparer.OrdinalIgnoreCase) then ValueSome StringComparison.OrdinalIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.InvariantCultureIgnoreCase) then ValueSome StringComparison.InvariantCultureIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.CurrentCultureIgnoreCase) then ValueSome StringComparison.CurrentCultureIgnoreCase - elif obj.ReferenceEquals (sc, StringComparer.Ordinal) then ValueSome StringComparison.Ordinal - elif obj.ReferenceEquals (sc, StringComparer.InvariantCulture) then ValueSome StringComparison.InvariantCulture - elif obj.ReferenceEquals (sc, StringComparer.CurrentCulture) then ValueSome StringComparison.CurrentCulture - else ValueNone - | _ -> ValueNone - - let rec buildFilterExpr isEnumerableQuery (param : SourceExpression) buildTypeDiscriminatorCheck filter : Expression = - - let build = buildFilterExpr isEnumerableQuery param buildTypeDiscriminatorCheck - - let (|NoCast|Enumerable|NonEnumerableCast|) value = - if obj.ReferenceEquals (value, null) then NoCast - else if isEnumerableQuery then Enumerable - else NonEnumerableCast (value.GetType ()) - - let unsafeConvertTo ``type`` ``member`` = Expression.Convert (Expression.Convert (``member``, objectType), ``type``) - - let normalizeStringMemberExpr (``member`` : MemberExpression) : Expression = - match ``member``.Type with - | t when t = stringType -> ``member`` - | _ when not isEnumerableQuery -> unsafeConvertTo stringType ``member`` - | _ when isEnumerableQuery -> Expression.Convert (Expression.Call (unwrapOptionMethod, ``member``), stringType) - | _ -> Expression.Convert (``member``, stringType) - - match filter with - | Not (Equals (f, comparer)) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match comparerToStringComparison comparer with - | ValueSome comparison -> - let value = Helpers.unwrap (box f.Value) :?> string - Expression.Not (Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, typeof), Expression.Constant comparison)) :> Expression - | ValueNone -> - let hasEqualityOperator = hasEqualityOperator ``member``.Type - match f.Value with - | NoCast when hasEqualityOperator -> Expression.NotEqual (``member``, Expression.Constant f.Value) - | NoCast - | NonEnumerableCast _ -> - Expression.NotEqual (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) - | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Not (Expression.Call (``const``, equalsMethod, ``member``)) - | Not f -> f |> build |> Expression.Not :> Expression - | And (f1, f2) -> Expression.AndAlso (build f1, build f2) - | Or (f1, f2) -> Expression.OrElse (build f1, build f2) - | Equals (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match comparerToStringComparison comparer with - | ValueSome comparison -> - let value = Helpers.unwrap (box f.Value) :?> string - Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, typeof), Expression.Constant comparison) :> Expression - | ValueNone -> - let hasEqualityOperator = hasEqualityOperator ``member``.Type - match f.Value with - | NoCast when hasEqualityOperator -> Expression.Equal (``member``, Expression.Constant f.Value) - | NoCast - | NonEnumerableCast _ -> - Expression.Equal (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) - | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Call (``const``, equalsMethod, ``member``) - | GreaterThan f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.GreaterThan (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.GreaterThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.GreaterThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | LessThan f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.LessThan (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.LessThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.LessThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | GreaterThanOrEqual f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.GreaterThanOrEqual (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.GreaterThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.GreaterThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | LessThanOrEqual f -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - match f.Value with - | NoCast -> Expression.LessThanOrEqual (``member``, Expression.Constant f.Value) - | Enumerable -> Expression.LessThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) - | NonEnumerableCast ``type`` -> Expression.LessThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) - | StartsWith (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison (comparer :> IComparer) |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringStartsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) - | EndsWith (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison (comparer :> IComparer) |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringEndsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) - - | Contains (f, comparer) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let isEnumerable (memberType : Type) = - not (Type.(=) (memberType, stringType)) - && typeof.IsAssignableFrom (memberType) - && memberType.GetInterfaces().Any (fun i -> i.FullName.StartsWith "System.Collections.Generic.IEnumerable`1") - let normalizedValue = Values.normalizeOptional ``member``.Type f.Value - let callContains memberType = - let itemType = - if ``member``.Type.IsArray then - ``member``.Type.GetElementType () - else - ``member``.Type.GetGenericArguments()[0] - let valueType = - match normalizedValue with - | null -> itemType - | value -> value.GetType () - let castedMember = - if itemType = valueType then - ``member`` :> Expression - elif isEnumerableQuery then - let castMethod = getEnumerableCastMethod valueType - Expression.Call (castMethod, ``member``) - else - let castedEnumerableType = genericIEnumerableType.MakeGenericType ([| valueType |]) - unsafeConvertTo castedEnumerableType ``member`` - match getCollectionInstanceContainsMethod memberType with - | ValueNone -> - let enumerableContains = getEnumerableContainsMethod valueType - Expression.Call (enumerableContains, castedMember, Expression.Constant (normalizedValue)) - | ValueSome instanceContainsMethod -> Expression.Call (castedMember, instanceContainsMethod, Expression.Constant (normalizedValue)) - match ``member``.Member with - | :? PropertyInfo as prop when prop.PropertyType |> isEnumerable -> callContains prop.PropertyType - | :? FieldInfo as field when field.FieldType |> isEnumerable -> callContains field.FieldType - | _ -> - let unwrappedValue = Helpers.unwrap f.Value - let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture - Expression.Call (normalizeStringMemberExpr ``member``, StringContainsMethod, Expression.Constant (unwrappedValue :?> string, typeof), Expression.Constant comparison) - | In f when not (f.Value.IsEmpty) -> - let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let enumerableContains = getEnumerableContainsMethod objectType - Expression.Call (enumerableContains, (Expression.Constant f.Value), Expression.Convert (``member``, objectType)) - | In f -> Expression.Constant (false) - | OfTypes types -> - types - |> Seq.map (fun t -> buildTypeDiscriminatorCheck param t) - |> Seq.reduce (fun acc expr -> Expression.OrElse (acc, expr)) - | FilterField f -> - let paramExpr = Expression.PropertyOrField (param, f.FieldName) - buildFilterExpr isEnumerableQuery (SourceExpression paramExpr) buildTypeDiscriminatorCheck f.Value - - type private CompareDiscriminatorExpressionVisitor<'T, 'D> - (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, param : SourceExpression, value : obj) = - inherit ExpressionVisitor () - override _.VisitParameter (node) = - if node = compareDiscriminator.Parameters.[0] then - param.Value - elif node = compareDiscriminator.Parameters.[1] then - Expression.Constant (value) :> Expression - else - node :> Expression - - let enumerableQueryType = typedefof> - - let apply (options : ObjectListFilterLinqOptions<'T, 'D>) (filter : ObjectListFilter) (query : IQueryable<'T>) = - let isEnumerableQuery = query.GetType().GetGenericTypeDefinition () = enumerableQueryType - // Helper for discriminator comparison - let buildTypeDiscriminatorCheck (param : SourceExpression) (t : Type) = - match options.CompareDiscriminator, options.GetDiscriminatorValue with - | ValueNone, ValueNone -> - Expression.Equal ( - // Default discriminator property - Expression.PropertyOrField (param, "__typename"), - // Default discriminator value - Expression.Constant (t.FullName) - ) - :> Expression - | ValueSome discExpr, ValueNone -> - // Replace parameters from the original expression with our new ones - let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, t.FullName) - replacer.Visit discExpr.Body - | ValueNone, ValueSome discValueFn -> - let discriminatorValue = discValueFn t - Expression.Equal ( - // Default discriminator property - Expression.PropertyOrField (param, "__typename"), - // Provided discriminator value gathered from type - Expression.Constant (discriminatorValue) - ) - :> Expression - | ValueSome discExpr, ValueSome discValueFn -> - let discriminatorValue = discValueFn t - // Replace parameters from the original expression with our new ones - let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, discriminatorValue) - replacer.Visit discExpr.Body - let queryExpr = - let param = Expression.Parameter (typeof<'T>, "x") - let body = buildFilterExpr isEnumerableQuery (SourceExpression param) buildTypeDiscriminatorCheck filter - whereExpr<'T> query param body - // Create and execute the final expression - query.Provider.CreateQuery<'T> (queryExpr) - -[] -module ObjectListFilterExtensions = - - open ObjectListFilter - - type ObjectListFilter with - - member inline filter.ApplyTo<'T, 'D> (query : IQueryable<'T>, [] options : ObjectListFilterLinqOptions<'T, 'D>) = - apply options filter query - - type IQueryable<'T> with + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, getDiscriminatorValue, null) + new (customCoercers : FilterValueCoercer list) = + ObjectListFilterLinqOptions<'T, 'D> (null, null, customCoercers) + new (getDiscriminator : Expression>, customCoercers : FilterValueCoercer list) = + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, customCoercers) + new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, customCoercers : FilterValueCoercer list) = + ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, customCoercers) - member inline query.Apply (filter : ObjectListFilter, [] options : ObjectListFilterLinqOptions<'T, 'D>) = apply options filter query diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs new file mode 100644 index 000000000..6ddfec8df --- /dev/null +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -0,0 +1,422 @@ +namespace FSharp.Data.GraphQL.Server.Middleware + +open System +open System.Collections +open System.Collections.Generic +open System.Linq +open System.Linq.Expressions +open System.Reflection +open System.Runtime.InteropServices +open FSharp.Data.GraphQL + +/// Contains tooling for working with ObjectListFilter. +[] +module ObjectListFilter = + /// Contains operators for building and comparing ObjectListFilter values. + module Operators = + /// Creates a new ObjectListFilter representing an AND operation between two existing ones. + let ( &&& ) x y = And (x, y) + + /// Creates a new ObjectListFilter representing an OR operation between two existing ones. + let ( ||| ) x y = Or (x, y) + + /// Creates a new ObjectListFilter representing an EQUALS operation between two comparable values. + let ( === ) fname value = Equals ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a GREATER THAN operation of a comparable value. + let ( >>> ) fname value = GreaterThan { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a GREATER THAN OR EQUAL operation of a comparable value. + let ( ==> ) fname value = GreaterThanOrEqual { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a LESS THAN operation of a comparable value. + let ( <<< ) fname value = LessThan { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a LESS THAN OR EQUAL operation of a comparable value. + let ( <== ) fname value = LessThanOrEqual { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a STARTS WITH operation of a string value. + let ( =@@ ) fname value = StartsWith ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing an ENDS WITH operation of a string value. + let ( @@= ) fname value = EndsWith ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a CONTAINS operation. + let ( @=@ ) fname value = Contains ({ FieldName = fname; Value = value }, null) + + /// Creates a new ObjectListFilter representing a IN operation. + let ( =~= ) fname value = In { FieldName = fname; Value = value } + + /// Creates a new ObjectListFilter representing a field sub comparison. + let ( --> ) fname filter = FilterField { FieldName = fname; Value = filter } + + /// Creates a new ObjectListFilter representing a NOT operation for the existing one. + let ( !!! ) filter = Not filter + + /// Creates a new ObjectListFilter representing a case-insensitive EQUALS operation on a string value. + let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive STARTS WITH operation on a string value. + let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive ENDS WITH operation on a string value. + let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + + /// Creates a new ObjectListFilter representing a case-insensitive CONTAINS operation on a string value. + let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + + let private genericWhereMethod = + let queryableType = typeof + queryableType.GetMethods () + |> Seq.where (fun m -> m.Name = "Where") + |> Seq.find (fun m -> + let parameters = m.GetParameters () + parameters.Length = 2 + && parameters[1].ParameterType.GetGenericTypeDefinition () = typedefof>>) + + // Helper to create Where expression + let whereExpr<'T> (query : IQueryable<'T>) (param : ParameterExpression) predicate = + let whereMethod = genericWhereMethod.MakeGenericMethod ([| typeof<'T> |]) + Expression.Call (whereMethod, [| query.Expression; Expression.Lambda> (predicate, param) |]) + + let private objectType = typeof + let private stringType = typeof + let private genericIEnumerableType = typedefof> + let private enumerableType = typeof + let private iEnumerableType = typeof + + let private stringComparisonType = typeof + let private StringStartsWithMethod = stringType.GetMethod ("StartsWith", [| stringType; stringComparisonType |]) + let private StringEndsWithMethod = stringType.GetMethod ("EndsWith", [| stringType; stringComparisonType |]) + let private StringContainsMethod = stringType.GetMethod ("Contains", [| stringType; stringComparisonType |]) + let private StringEqualsMethod = stringType.GetMethod ("Equals", [| stringType; stringComparisonType |]) + let private unwrapOptionMethod = + FSharp.Data.GraphQL.Helpers.moduleType.GetMethod (nameof Helpers.unwrap) + + let private getCollectionInstanceContainsMethod (memberType : Type) = + memberType + .GetMethods(BindingFlags.Instance ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 1) + |> ValueOption.ofObj + + let private getEnumerableContainsMethod (itemType : Type) = + match + enumerableType + .GetMethods(BindingFlags.Static ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Contains" && m.GetParameters().Length = 2) + with + | null -> raise (MissingMemberException "Static 'Contains' method with 2 parameters not found on 'Enumerable' class") + | containsGenericStaticMethod -> containsGenericStaticMethod.MakeGenericMethod ([| itemType |]) + + let private getEnumerableCastMethod (itemType : Type) = + match + enumerableType + .GetMethods(BindingFlags.Static ||| BindingFlags.Public) + .FirstOrDefault (fun m -> m.Name = "Cast" && m.GetParameters().Length = 1) + with + | null -> raise (MissingMemberException "Static 'Cast' method with 1 parameter not found on 'Enumerable' class") + | castGenericStaticMethod -> castGenericStaticMethod.MakeGenericMethod ([| itemType |]) + + let getField (param : ParameterExpression) fieldName = Expression.PropertyOrField (param, fieldName) + + let hasEqualityOperator (``type`` : Type) = + ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) + |> Seq.exists (fun m -> m.Name = " op_Equality") + + let hasInequalityOperator (``type`` : Type) = + ``type``.GetMethods (BindingFlags.Public ||| BindingFlags.Static) + |> Seq.exists (fun m -> m.Name = "op_Inequality") + + [] + type SourceExpression private (expression : Expression) = + new (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) + new (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) + member _.Value = expression + static member op_Implicit (source : SourceExpression) = source.Value + static member op_Implicit (parameter : ParameterExpression) = SourceExpression (parameter :> Expression) + static member op_Implicit (``member`` : MemberExpression) = SourceExpression (``member`` :> Expression) + + let equalsMethod = + objectType + |> _.GetMethods(BindingFlags.Instance ||| BindingFlags.Public) + |> Seq.where (fun m -> m.Name = "Equals") + |> Seq.head + + let staticEqualsMethod = + objectType + |> _.GetMethods(BindingFlags.Static ||| BindingFlags.Public) + |> Seq.where (fun m -> m.Name = "Equals") + |> Seq.head + + /// Maps an IComparer to a StringComparison value. + /// Returns ValueNone for null or Ordinal comparers (use default Expression.Equal path). + let private comparerToStringComparison (comparer : IComparer) = + match comparer with + | null -> ValueNone + | :? StringComparer as sc -> + if obj.ReferenceEquals (sc, StringComparer.OrdinalIgnoreCase) then ValueSome StringComparison.OrdinalIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.InvariantCultureIgnoreCase) then ValueSome StringComparison.InvariantCultureIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.CurrentCultureIgnoreCase) then ValueSome StringComparison.CurrentCultureIgnoreCase + elif obj.ReferenceEquals (sc, StringComparer.Ordinal) then ValueSome StringComparison.Ordinal + elif obj.ReferenceEquals (sc, StringComparer.InvariantCulture) then ValueSome StringComparison.InvariantCulture + elif obj.ReferenceEquals (sc, StringComparer.CurrentCulture) then ValueSome StringComparison.CurrentCulture + else ValueNone + | _ -> ValueNone + + let rec buildFilterExpr isEnumerableQuery (param : SourceExpression) buildTypeDiscriminatorCheck filter : Expression = + + let build = buildFilterExpr isEnumerableQuery param buildTypeDiscriminatorCheck + + let (|NoCast|Enumerable|NonEnumerableCast|) value = + if obj.ReferenceEquals (value, null) then NoCast + else if isEnumerableQuery then Enumerable + else NonEnumerableCast (value.GetType ()) + + let unsafeConvertTo ``type`` ``member`` = Expression.Convert (Expression.Convert (``member``, objectType), ``type``) + + let normalizeStringMemberExpr (``member`` : MemberExpression) : Expression = + match ``member``.Type with + | t when t = stringType -> ``member`` + | _ when not isEnumerableQuery -> unsafeConvertTo stringType ``member`` + | _ when isEnumerableQuery -> Expression.Convert (Expression.Call (unwrapOptionMethod, ``member``), stringType) + | _ -> Expression.Convert (``member``, stringType) + + match filter with + | Not (Equals (f, comparer)) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match comparerToStringComparison comparer with + | ValueSome comparison -> + let value = Helpers.unwrap (box f.Value) :?> string + Expression.Not (Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, stringType), Expression.Constant comparison)) :> Expression + | ValueNone -> + let hasEqualityOperator = hasEqualityOperator ``member``.Type + match f.Value with + | NoCast when hasEqualityOperator -> Expression.NotEqual (``member``, Expression.Constant f.Value) + | NoCast + | NonEnumerableCast _ -> + Expression.NotEqual (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) + | Enumerable -> + let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) + Expression.Not (Expression.Call (``const``, equalsMethod, ``member``)) + | Not f -> f |> build |> Expression.Not :> Expression + | And (f1, f2) -> Expression.AndAlso (build f1, build f2) + | Or (f1, f2) -> Expression.OrElse (build f1, build f2) + | Equals (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match comparerToStringComparison comparer with + | ValueSome comparison -> + let value = Helpers.unwrap (box f.Value) :?> string + Expression.Call (normalizeStringMemberExpr ``member``, StringEqualsMethod, Expression.Constant (value, stringType), Expression.Constant comparison) :> Expression + | ValueNone -> + let hasEqualityOperator = hasEqualityOperator ``member``.Type + match f.Value with + | NoCast when hasEqualityOperator -> Expression.Equal (``member``, Expression.Constant f.Value) + | NoCast + | NonEnumerableCast _ -> + Expression.Equal (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) + | Enumerable -> + let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) + Expression.Call (``const``, equalsMethod, ``member``) + | GreaterThan f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.GreaterThan (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.GreaterThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.GreaterThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | LessThan f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.LessThan (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.LessThan (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.LessThan ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | GreaterThanOrEqual f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.GreaterThanOrEqual (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.GreaterThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.GreaterThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | LessThanOrEqual f -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + match f.Value with + | NoCast -> Expression.LessThanOrEqual (``member``, Expression.Constant f.Value) + | Enumerable -> Expression.LessThanOrEqual (``member``, Expression.Constant (Values.normalizeOptional ``member``.Type f.Value)) + | NonEnumerableCast ``type`` -> Expression.LessThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) + | StartsWith (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + Expression.Call (normalizeStringMemberExpr ``member``, StringStartsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) + | EndsWith (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + Expression.Call (normalizeStringMemberExpr ``member``, StringEndsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) + + | Contains (f, comparer) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let isEnumerable (memberType : Type) = + not (Type.(=) (memberType, stringType)) + && iEnumerableType.IsAssignableFrom (memberType) + && memberType.GetInterfaces().Any (fun i -> i.FullName.StartsWith "System.Collections.Generic.IEnumerable`1") + let normalizedValue = Values.normalizeOptional ``member``.Type f.Value + let callContains memberType = + let itemType = + if ``member``.Type.IsArray then + ``member``.Type.GetElementType () + else + ``member``.Type.GetGenericArguments()[0] + let valueType = + match normalizedValue with + | null -> itemType + | value -> value.GetType () + let castedMember = + if itemType = valueType then + ``member`` :> Expression + elif isEnumerableQuery then + let castMethod = getEnumerableCastMethod valueType + Expression.Call (castMethod, ``member``) + else + let castedEnumerableType = genericIEnumerableType.MakeGenericType ([| valueType |]) + unsafeConvertTo castedEnumerableType ``member`` + match getCollectionInstanceContainsMethod memberType with + | ValueNone -> + let enumerableContains = getEnumerableContainsMethod valueType + Expression.Call (enumerableContains, castedMember, Expression.Constant (normalizedValue)) + | ValueSome instanceContainsMethod -> Expression.Call (castedMember, instanceContainsMethod, Expression.Constant (normalizedValue)) + match ``member``.Member with + | :? PropertyInfo as prop when prop.PropertyType |> isEnumerable -> callContains prop.PropertyType + | :? FieldInfo as field when field.FieldType |> isEnumerable -> callContains field.FieldType + | _ -> + let unwrappedValue = Helpers.unwrap f.Value + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + Expression.Call (normalizeStringMemberExpr ``member``, StringContainsMethod, Expression.Constant (unwrappedValue :?> string, stringType), Expression.Constant comparison) + | In f when not (f.Value.IsEmpty) -> + let ``member`` = Expression.PropertyOrField (param, f.FieldName) + let enumerableContains = getEnumerableContainsMethod objectType + Expression.Call (enumerableContains, (Expression.Constant f.Value), Expression.Convert (``member``, objectType)) + | In f -> Expression.Constant (false) + | OfTypes types -> + types + |> Seq.map (fun t -> buildTypeDiscriminatorCheck param t) + |> Seq.reduce (fun acc expr -> Expression.OrElse (acc, expr)) + | FilterField f -> + let paramExpr = Expression.PropertyOrField (param, f.FieldName) + buildFilterExpr isEnumerableQuery (SourceExpression paramExpr) buildTypeDiscriminatorCheck f.Value + + type private CompareDiscriminatorExpressionVisitor<'T, 'D> + (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, param : SourceExpression, value : obj) = + inherit ExpressionVisitor () + override _.VisitParameter (node) = + if node = compareDiscriminator.Parameters.[0] then + param.Value + elif node = compareDiscriminator.Parameters.[1] then + Expression.Constant (value) :> Expression + else + node :> Expression + + let enumerableQueryType = typedefof> + + let apply (options : ObjectListFilterLinqOptions<'T, 'D>) (filter : ObjectListFilter) (query : IQueryable<'T>) = + let isEnumerableQuery = query.GetType().GetGenericTypeDefinition () = enumerableQueryType + // Helper for discriminator comparison + let buildTypeDiscriminatorCheck (param : SourceExpression) (t : Type) = + match options.CompareDiscriminator, options.GetDiscriminatorValue with + | ValueNone, ValueNone -> + Expression.Equal ( + // Default discriminator property + Expression.PropertyOrField (param, "__typename"), + // Default discriminator value + Expression.Constant (t.FullName) + ) + :> Expression + | ValueSome discExpr, ValueNone -> + // Replace parameters from the original expression with our new ones + let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, t.FullName) + replacer.Visit discExpr.Body + | ValueNone, ValueSome discValueFn -> + let discriminatorValue = discValueFn t + Expression.Equal ( + // Default discriminator property + Expression.PropertyOrField (param, "__typename"), + // Provided discriminator value gathered from type + Expression.Constant (discriminatorValue) + ) + :> Expression + | ValueSome discExpr, ValueSome discValueFn -> + let discriminatorValue = discValueFn t + // Replace parameters from the original expression with our new ones + let replacer = CompareDiscriminatorExpressionVisitor (discExpr, param, discriminatorValue) + replacer.Visit discExpr.Body + let queryExpr = + let param = Expression.Parameter (typeof<'T>, "x") + let body = buildFilterExpr isEnumerableQuery (SourceExpression param) buildTypeDiscriminatorCheck filter + whereExpr<'T> query param body + // Create and execute the final expression + query.Provider.CreateQuery<'T> (queryExpr) + +[] +module ObjectListFilterExtensions = + + open ObjectListFilter + + type ObjectListFilter with + + /// + /// Applies the filter to a queryable with automatic type coercion of JSON primitives to CLR types. + /// Supports , , , , and F# discriminated unions. + /// Pass custom coercers via ObjectListFilterLinqOptions constructor. + /// + /// + /// + /// // Basic usage - automatic coercion of string to Guid + /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" + /// let users = filter.ApplyTo query + /// + /// // With custom coercer for NodaTime.Instant + /// let nodaCoercer : FilterValueCoercer = fun targetType value -> + /// if targetType = typeof<NodaTime.Instant> then + /// match value with + /// | :? string as s -> + /// let parsed = NodaTime.Text.InstantPattern.ExtendedIso.Parse s + /// if parsed.Success then ValueSome (box parsed.Value) + /// else ValueNone + /// | _ -> ValueNone + /// else ValueNone + /// + /// let options = ObjectListFilterLinqOptions([nodaCoercer]) + /// let events = filter.ApplyTo(query, options) + /// + /// + member inline filter.ApplyTo<'T, 'D> (query : IQueryable<'T>, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = + let options = options |> ValueOption.ofObj |> ValueOption.defaultValue ObjectListFilterLinqOptions<'T, 'D>.None + let filter = TypeCoercion.coerceFilter options.CustomCoercers typeof<'T> filter + apply options filter query + + type IQueryable<'T> with + + /// + /// Applies the filter with automatic type coercion of JSON primitives to CLR types. Supports , , + /// , , and F# discriminated unions. Pass custom coercers via + /// ObjectListFilterLinqOptions constructor. + /// + /// + /// + /// // Basic usage - automatic coercion of string to Guid + /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" + /// let users = query.Apply filter + /// + /// // With custom coercer for NodaTime.Instant + /// let nodaCoercer : FilterValueCoercer = fun targetType value -> + /// if targetType = typeof<NodaTime.Instant> then + /// match value with + /// | :? string as s -> + /// let parsed = NodaTime.Text.InstantPattern.ExtendedIso.Parse s + /// if parsed.Success then ValueSome (box parsed.Value) + /// else ValueNone + /// | _ -> ValueNone + /// else ValueNone + /// + /// let options = ObjectListFilterLinqOptions([nodaCoercer]) + /// let events = query.Apply(filter, options) + /// + /// + member inline query.Apply (filter : ObjectListFilter, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = + apply options filter query diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs index 813c3b7bb..efd594a8e 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs @@ -20,7 +20,6 @@ type private ComparisonOperator = | LessThanOrEqual of string | In of string - let rec private coerceObjectListFilterInput (variables : Variables) inputValue : Result = let parseFieldCondition (s : string) = diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs new file mode 100644 index 000000000..2e1265432 --- /dev/null +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -0,0 +1,298 @@ +namespace FSharp.Data.GraphQL.Server.Middleware + +open System +open System.Collections.Generic +open System.Collections.Immutable +open System.Reflection +open FSharp.Data.GraphQL +open FSharp.Data.GraphQL.Extensions +open FSharp.Reflection + +[] +module TypeCoercion = + + /// Case-insensitive instance property lookup. The middleware lowercases field names during + /// parsing, so we must also ignore casing here. + let propertyBindFlags = + BindingFlags.Public + ||| BindingFlags.Instance + ||| BindingFlags.IgnoreCase + + /// DU/union member access flags. Internal cases must be resolvable through reflection. + let unionBindFlags = BindingFlags.Public ||| BindingFlags.NonPublic + + // Cached type references + let private stringType = typeof + + /// + /// If is voption, option, or Skippable, returns the inner type; + /// otherwise . + /// + let tryUnwrapOption (t : Type) : Type voption = + if t.IsGenericType then + let fullName = t.GetGenericTypeDefinition().FullName + if + fullName.StartsWith ReflectionHelper.ValueOptionTypeName + || fullName.StartsWith ReflectionHelper.OptionTypeName + || fullName.StartsWith ReflectionHelper.SkippableTypeName + then + ValueSome (t.GetGenericArguments().[0]) + else + ValueNone + else + ValueNone + + let unwrapOption (t : Type) : Type = + tryUnwrapOption t |> ValueOption.defaultValue t + + /// + /// If is a generic collection, returns the element type. Handles both concrete + /// collections (where IEnumerable is an implemented interface) and properties typed directly as IEnumerable<T>. + /// + let tryUnwrapEnumerableElement (t : Type) : Type voption = + let isEnumerableInterface (i : Type) = + i.IsGenericType + && Type.(=) (i.GetGenericTypeDefinition (), typedefof>) + if Type.(=) (t, stringType) then + ValueNone + elif t.IsArray then + t.GetElementType () |> ValueOption.ofObj + elif isEnumerableInterface t then + ValueSome (t.GetGenericArguments()[0]) + else + t.GetInterfaces () + |> Array.vtryFind isEnumerableInterface + |> ValueOption.map (fun i -> i.GetGenericArguments()[0]) + + /// + /// Suffixes the middleware's parser preserves on FieldFilter.FieldName for scalar + /// operators (e.g. meetingId_eq, validFrom_gte). They must be stripped before + /// resolving the actual CLR property. + /// + /// These correspond to the lowercase variants produced after Phase 2 parsing in + /// SchemaDefinitions.parseFieldCondition. Longer suffixes are listed first to prevent + /// shorter ones (e.g. _gt) from incorrectly matching longer ones (e.g. _gte). + /// + let operatorSuffixes = + [| + // String operators (case-insensitive variants) + FilterSuffixConstants.CI.StartsWithSuffix + FilterSuffixConstants.CI.EndsWithSuffix + FilterSuffixConstants.CI.SWSuffix + FilterSuffixConstants.CI.EWSuffix + FilterSuffixConstants.CI.ContainsSuffix + FilterSuffixConstants.CI.EqualsSuffix + FilterSuffixConstants.CI.EQSuffix + // String operators (case-sensitive variants) + FilterSuffixConstants.CS.StartsWithSuffix + FilterSuffixConstants.CS.EndsWithSuffix + FilterSuffixConstants.CS.SWSuffix + FilterSuffixConstants.CS.EWSuffix + FilterSuffixConstants.CS.ContainsSuffix + FilterSuffixConstants.CS.EqualsSuffix + FilterSuffixConstants.CS.EQSuffix + // Numeric/comparison operators (from root) + FilterSuffixConstants.GreaterThanOrEqualSuffix + FilterSuffixConstants.LessThanOrEqualSuffix + FilterSuffixConstants.GreaterThanSuffix + FilterSuffixConstants.LessThanSuffix + FilterSuffixConstants.GTESuffix + FilterSuffixConstants.LTESuffix + FilterSuffixConstants.GTSuffix + FilterSuffixConstants.LTSuffix + FilterSuffixConstants.InSuffix + |] + + let stripOperatorSuffix (fieldName : string) : string = + operatorSuffixes + |> Array.vtryFind (fun s -> fieldName.EndsWith (s, StringComparison.OrdinalIgnoreCase)) + |> ValueOption.map (fun s -> fieldName.Substring (0, fieldName.Length - s.Length)) + |> ValueOption.defaultValue fieldName + + // Cached type references for coercion + let private guidType = typeof + let private dateTimeOffsetType = typeof + let private dateTimeType = typeof + let private dateOnlyType = typeof + let private timeOnlyType = typeof + + /// + /// Built-in type coercers for common CLR types. Each coercer takes a boxed value + /// and attempts to parse it (typically from a string) into the target type. + /// + let private builtInCoercers : ImmutableDictionary obj voption> = + let tryParseString (tryParse : string -> bool * 'T) (value : obj) : obj voption = + match value with + | :? string as s -> + match tryParse s with + | true, result -> ValueSome (box result) + | false, _ -> ValueNone + | _ -> ValueNone + + seq { + kvp guidType (tryParseString Guid.TryParse) + kvp dateTimeOffsetType (tryParseString DateTimeOffset.TryParse) + kvp dateTimeType (tryParseString DateTime.TryParse) + kvp dateOnlyType (tryParseString DateOnly.TryParse) + kvp timeOnlyType (tryParseString TimeOnly.TryParse) + } + |> ImmutableDictionary.CreateRange + + /// + /// Tries to coerce a JSON-parsed primitive value (typically a ) into the + /// CLR . Supports , , + /// , , , and single-case F# DUs around any + /// of the above. Multi-case DUs with fieldless cases are also supported (matches case name + /// case-insensitively). + /// + // Suppress nullness warnings for the obj / objnull mixture: JSON values can theoretically + // be null but in our middleware path the caller always boxes a non-null primitive. + #nowarn "3261" + let rec tryCoerceValue (customCoercers : FilterValueCoercer list) (targetType : Type) (value : obj | null) : obj voption = + if isNull value then + ValueNone + elif targetType.IsInstanceOfType value then + // Fast path: already the right type. + ValueSome value + else + // Try custom coercers first + let customResult = + customCoercers + |> List.vtryPick (fun coercer -> coercer targetType value) + + match customResult with + | ValueSome coerced -> ValueSome coerced + | ValueNone -> + // Try built-in coercers from the static dictionary + match builtInCoercers.TryGetValue targetType with + | true, coercer -> coercer value + | false, _ -> + // F# DU handling + if FSharpType.IsUnion (targetType, unionBindFlags) then + let cases = FSharpType.GetUnionCases (targetType, unionBindFlags) + if cases.Length = 1 then + // Single-case DU wrapping: unwrap one layer and recurse. + let case = cases[0] + let fields = case.GetFields () + if fields.Length = 1 then + let innerType = fields[0].PropertyType + match tryCoerceValue customCoercers innerType value with + | ValueSome innerVal -> + ValueSome (FSharpValue.MakeUnion (case, [| innerVal |], unionBindFlags)) + | ValueNone -> ValueNone + else + ValueNone + else + // Multi-case DU: if the value is a string matching a fieldless case, create that case. + match value with + | :? string as str -> + cases + |> Array.vtryFind (fun c -> + c.GetFields().Length = 0 + && String.Equals (c.Name, str, StringComparison.OrdinalIgnoreCase)) + |> ValueOption.map (fun c -> FSharpValue.MakeUnion (c, [||], unionBindFlags)) + | _ -> ValueNone + else + ValueNone + + /// + /// Coerces an entire tree recursively by resolving the + /// entities's properties and converting filter values into the property's CLR type. + /// + let rec coerceFilter (customCoercers : FilterValueCoercer list) (entityType : Type) (filter : ObjectListFilter) : ObjectListFilter = + match filter with + | And (l, r) -> And (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r) + | Or (l, r) -> Or (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r) + | Not f -> Not (coerceFilter customCoercers entityType f) + | OfTypes _ -> filter + | Equals (ff, cmp) -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + match tryCoerceValue customCoercers unwrapped (box ff.Value) with + | ValueNone -> filter + | ValueSome coerced -> Equals ({ ff with Value = coerced :?> IComparable }, cmp) + | GreaterThan ff + | GreaterThanOrEqual ff + | LessThan ff + | LessThanOrEqual ff as originalFilter -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + // For comparison operators, if the property is a single-case DU, coerce to the + // inner type only — not the DU itself. buildFilterExpr handles the cast via + // unsafeConvertTo, and the DU's op_GreaterThan etc. take the inner primitive. + let coercionTarget = + match tryUnwrapOption unwrapped with + | ValueSome inner -> inner // already unwrapped above, shouldn't occur + | ValueNone -> + if FSharpType.IsUnion (unwrapped, unionBindFlags) then + let cases = FSharpType.GetUnionCases (unwrapped, unionBindFlags) + if cases.Length = 1 then + let fields = cases[0].GetFields () + if fields.Length = 1 then fields[0].PropertyType + else unwrapped + else unwrapped + else unwrapped + match tryCoerceValue customCoercers coercionTarget (box ff.Value) with + | ValueNone -> filter + | ValueSome coerced -> + let coercedField = { ff with Value = coerced :?> IComparable } + match originalFilter with + | GreaterThan _ -> GreaterThan coercedField + | GreaterThanOrEqual _ -> GreaterThanOrEqual coercedField + | LessThan _ -> LessThan coercedField + | LessThanOrEqual _ -> LessThanOrEqual coercedField + | _ -> filter + | In ff -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + let coercedList = + ff.Value + |> List.choose (fun item -> + match tryCoerceValue customCoercers unwrapped item with + | ValueSome coerced -> Some coerced + | ValueNone -> None) + In { ff with Value = coercedList } + | StartsWith (ff, cmp) + | EndsWith (ff, cmp) as originalFilter -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | _ -> + // The pattern argument for string operators is always a plain string — + // never coerce it into the member's DU type. + match tryCoerceValue customCoercers stringType (box ff.Value) with + | ValueNone -> filter + | ValueSome coerced -> + let coercedField = { ff with Value = coerced :?> string } + match originalFilter with + | StartsWith (_, cmp) -> StartsWith (coercedField, cmp) + | EndsWith (_, cmp) -> EndsWith (coercedField, cmp) + | _ -> filter + | Contains (ff, cmp) -> + match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + // For enumerable members coerce to the element type; for string-like members + // keep the pattern value as a plain string (same reasoning as StartsWith/EndsWith). + let coercionTarget = + match tryUnwrapEnumerableElement unwrapped with + | ValueSome elementType -> elementType + | ValueNone -> stringType + match tryCoerceValue customCoercers coercionTarget (box ff.Value) with + | ValueNone -> filter + | ValueSome coerced -> Contains ({ ff with Value = coerced :?> IComparable }, cmp) + | FilterField ff -> + match entityType.GetProperty (ff.FieldName, propertyBindFlags) with + | null -> filter + | prop -> + let unwrapped = unwrapOption prop.PropertyType + let nestedType = + tryUnwrapEnumerableElement unwrapped + |> ValueOption.defaultValue unwrapped + FilterField { FieldName = ff.FieldName; Value = coerceFilter customCoercers nestedType ff.Value } diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs index 955684e1e..215e321fb 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs @@ -3,9 +3,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections.Immutable open System.Linq -open FsToolkit.ErrorHandling -open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Types /// Contains extensions for the type system. diff --git a/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs b/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs index 603ba60fc..b1a260995 100644 --- a/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs +++ b/src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs @@ -85,6 +85,35 @@ module Array = i <- i + 1 Array.sub temp 0 i + /// + /// Attempts to find the first element in an array that satisfies the given predicate. + /// + /// Function to test each element. + /// The input array. + /// ValueSome of the first matching element, or ValueNone if no match is found. + let vtryFind predicate (source : 'T array) = + let mutable result = ValueNone + let mutable i = 0 + while i < source.Length && result.IsNone do + if predicate source[i] then + result <- ValueSome source[i] + i <- i + 1 + result + + /// + /// Applies a function to each element of an array and returns the first result where the function returns ValueSome. + /// + /// Function to apply to each element. + /// The input array. + /// ValueSome of the first successful mapping result, or ValueNone if no match is found. + let vtryPick mapping (source : 'T array) = + let mutable result = ValueNone + let mutable i = 0 + while i < source.Length && result.IsNone do + result <- mapping source[i] + i <- i + 1 + result + module List = /// @@ -99,6 +128,35 @@ module List = |> List.filter (fun x -> not <| List.exists(fun y -> f(x) = f(y)) listy) uniqx @ listy + /// + /// Attempts to find the first element in a list that satisfies the given predicate. + /// + /// Function to test each element. + /// The input list. + /// ValueSome of the first matching element, or ValueNone if no match is found. + let rec vtryFind predicate (source : 'T list) = + match source with + | [] -> ValueNone + | head :: tail -> + if predicate head then + ValueSome head + else + vtryFind predicate tail + + /// + /// Applies a function to each element of a list and returns the first result where the function returns ValueSome. + /// + /// Function to apply to each element. + /// The input list. + /// ValueSome of the first successful mapping result, or ValueNone if no match is found. + let rec vtryPick mapping (source : 'T list) = + match source with + | [] -> ValueNone + | head :: tail -> + match mapping head with + | ValueSome result -> ValueSome result + | ValueNone -> vtryPick mapping tail + module Set = /// From 39643211362e46221af686ecef22be1cda3f8265 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 00:47:06 +0200 Subject: [PATCH 02/10] Refactor 'ObjectListFilter' to use 'System.Text.Json' coercion Replaces custom value coercers with 'System.Text.Json'-based coercion in 'ObjectListFilter', supporting advanced scenarios like F# DUs and CLR enums via 'JsonSerializerOptions'. Updates 'ObjectListFilterLinqOptions' to accept 'JsonSerializerOptions'. Refactors 'TypeCoercion' module to use JSON serialization/deserialization for all type conversions. Updates filter application logic and expands the test suite with new files to cover a wide range of coercion scenarios. Updates documentation and usage examples accordingly. --- .../ObjectListFilter.fs | 23 +- .../ObjectListFilterModule.fs | 50 ++-- .../TypeCoercion.fs | 175 ++++--------- .../FSharp.Data.GraphQL.Tests.fsproj | 7 +- .../ObjectListFilterLinqGenerateTests.fs | 0 .../ObjectListFilterLinqTests.fs | 0 .../TypeCoercionFilterTests.fs | 239 ++++++++++++++++++ .../TypeCoercionTests.Common.fs | 135 ++++++++++ .../TypeCoercionValueTests.fs | 209 +++++++++++++++ 9 files changed, 662 insertions(+), 176 deletions(-) rename tests/FSharp.Data.GraphQL.Tests/{ => ObjectListFilter}/ObjectListFilterLinqGenerateTests.fs (100%) rename tests/FSharp.Data.GraphQL.Tests/{ => ObjectListFilter}/ObjectListFilterLinqTests.fs (100%) create mode 100644 tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs create mode 100644 tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs create mode 100644 tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index 607ed0392..a02c73ce0 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -2,6 +2,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections +open System.Text.Json open FSharp.Data.GraphQL /// A filter definition for a field value. @@ -46,12 +47,6 @@ type private CompareDiscriminatorExpression<'T, 'D> = Expression] extensions : Dictionary | null) = inherit GQLMessageExceptionBase (ErrorKind.Validation, message, extensions) -/// -/// Function signature for custom value coercion logic. Takes a target CLR type and a JSON -/// primitive value, returns the coerced value or if coercion is not supported. -/// -type FilterValueCoercer = Type -> obj -> obj voption - /// /// Optional configuration for LINQ translation including discriminator handling. /// @@ -59,12 +54,12 @@ type ObjectListFilterLinqOptions<'T, 'D> ( [] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, [] getDiscriminatorValue : (Type -> 'D) | null, - [] customCoercers : FilterValueCoercer list | null + [] jsonOptions : JsonSerializerOptions | null ) = member _.CompareDiscriminator = compareDiscriminator |> ValueOption.ofObj member _.GetDiscriminatorValue = getDiscriminatorValue |> ValueOption.ofObj - member _.CustomCoercers = customCoercers |> Option.ofObj |> Option.defaultValue [] + member _.JsonOptions = jsonOptions |> ValueOption.ofObj static member None = ObjectListFilterLinqOptions<'T, 'D> (null, null, null) @@ -82,10 +77,10 @@ type ObjectListFilterLinqOptions<'T, 'D> ObjectListFilterLinqOptions<'T, 'D> (null, getDiscriminatorValue, null) new (getDiscriminator : Expression>, getDiscriminatorValue : Type -> 'D) = ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, getDiscriminatorValue, null) - new (customCoercers : FilterValueCoercer list) = - ObjectListFilterLinqOptions<'T, 'D> (null, null, customCoercers) - new (getDiscriminator : Expression>, customCoercers : FilterValueCoercer list) = - ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, customCoercers) - new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, customCoercers : FilterValueCoercer list) = - ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, customCoercers) + new (jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (null, null, jsonOptions) + new (getDiscriminator : Expression>, jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (ObjectListFilterLinqOptions.GetCompareDiscriminator getDiscriminator, null, jsonOptions) + new (compareDiscriminator : CompareDiscriminatorExpression<'T, 'D>, jsonOptions : JsonSerializerOptions) = + ObjectListFilterLinqOptions<'T, 'D> (compareDiscriminator, null, jsonOptions) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs index 6ddfec8df..21ca7cdc5 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -196,8 +196,10 @@ module ObjectListFilter = | NonEnumerableCast _ -> Expression.NotEqual (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Not (Expression.Call (``const``, equalsMethod, ``member``)) + let normalized = Values.normalizeOptional ``member``.Type f.Value + let ``const`` = Expression.Constant (normalized) + let boxedArg = Expression.Convert (``member``, objectType) + Expression.Not (Expression.Call (``const``, equalsMethod, boxedArg)) | Not f -> f |> build |> Expression.Not :> Expression | And (f1, f2) -> Expression.AndAlso (build f1, build f2) | Or (f1, f2) -> Expression.OrElse (build f1, build f2) @@ -215,8 +217,10 @@ module ObjectListFilter = | NonEnumerableCast _ -> Expression.Equal (Expression.Convert (``member``, objectType), Expression.Convert ((Expression.Constant f.Value), objectType)) | Enumerable -> - let ``const`` = Expression.Constant (Values.normalizeOptional ``member``.Type f.Value) - Expression.Call (``const``, equalsMethod, ``member``) + let normalized = Values.normalizeOptional ``member``.Type f.Value + let ``const`` = Expression.Constant (normalized) + let boxedArg = Expression.Convert (``member``, objectType) + Expression.Call (``const``, equalsMethod, boxedArg) | GreaterThan f -> let ``member`` = Expression.PropertyOrField (param, f.FieldName) match f.Value with @@ -362,7 +366,7 @@ module ObjectListFilterExtensions = /// /// Applies the filter to a queryable with automatic type coercion of JSON primitives to CLR types. /// Supports , , , , and F# discriminated unions. - /// Pass custom coercers via ObjectListFilterLinqOptions constructor. + /// Pass via ObjectListFilterLinqOptions constructor for custom serialization. /// /// /// @@ -370,32 +374,23 @@ module ObjectListFilterExtensions = /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" /// let users = filter.ApplyTo query /// - /// // With custom coercer for NodaTime.Instant - /// let nodaCoercer : FilterValueCoercer = fun targetType value -> - /// if targetType = typeof<NodaTime.Instant> then - /// match value with - /// | :? string as s -> - /// let parsed = NodaTime.Text.InstantPattern.ExtendedIso.Parse s - /// if parsed.Success then ValueSome (box parsed.Value) - /// else ValueNone - /// | _ -> ValueNone - /// else ValueNone - /// - /// let options = ObjectListFilterLinqOptions([nodaCoercer]) + /// // With custom JsonSerializerOptions + /// let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true) + /// let options = ObjectListFilterLinqOptions(opts) /// let events = filter.ApplyTo(query, options) /// /// member inline filter.ApplyTo<'T, 'D> (query : IQueryable<'T>, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = let options = options |> ValueOption.ofObj |> ValueOption.defaultValue ObjectListFilterLinqOptions<'T, 'D>.None - let filter = TypeCoercion.coerceFilter options.CustomCoercers typeof<'T> filter + let filter = TypeCoercion.coerceFilter options.JsonOptions typeof<'T> filter apply options filter query type IQueryable<'T> with /// /// Applies the filter with automatic type coercion of JSON primitives to CLR types. Supports , , - /// , , and F# discriminated unions. Pass custom coercers via - /// ObjectListFilterLinqOptions constructor. + /// , , and F# discriminated unions. Pass via + /// ObjectListFilterLinqOptions constructor for custom serialization. /// /// /// @@ -403,18 +398,9 @@ module ObjectListFilterExtensions = /// let filter = "id" === "550e8400-e29b-41d4-a716-446655440000" /// let users = query.Apply filter /// - /// // With custom coercer for NodaTime.Instant - /// let nodaCoercer : FilterValueCoercer = fun targetType value -> - /// if targetType = typeof<NodaTime.Instant> then - /// match value with - /// | :? string as s -> - /// let parsed = NodaTime.Text.InstantPattern.ExtendedIso.Parse s - /// if parsed.Success then ValueSome (box parsed.Value) - /// else ValueNone - /// | _ -> ValueNone - /// else ValueNone - /// - /// let options = ObjectListFilterLinqOptions([nodaCoercer]) + /// // With custom JsonSerializerOptions + /// let opts = JsonSerializerOptions(PropertyNameCaseInsensitive = true) + /// let options = ObjectListFilterLinqOptions(opts) /// let events = query.Apply(filter, options) /// /// diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs index 2e1265432..efcdca1f9 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -2,11 +2,10 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections.Generic -open System.Collections.Immutable open System.Reflection +open System.Text.Json open FSharp.Data.GraphQL open FSharp.Data.GraphQL.Extensions -open FSharp.Reflection [] module TypeCoercion = @@ -18,15 +17,11 @@ module TypeCoercion = ||| BindingFlags.Instance ||| BindingFlags.IgnoreCase - /// DU/union member access flags. Internal cases must be resolvable through reflection. - let unionBindFlags = BindingFlags.Public ||| BindingFlags.NonPublic - // Cached type references let private stringType = typeof /// - /// If is voption, option, or Skippable, returns the inner type; - /// otherwise . + /// If is voption, option, or Skippable, returns the inner type; otherwise . /// let tryUnwrapOption (t : Type) : Type voption = if t.IsGenericType then @@ -46,8 +41,8 @@ module TypeCoercion = tryUnwrapOption t |> ValueOption.defaultValue t /// - /// If is a generic collection, returns the element type. Handles both concrete - /// collections (where IEnumerable is an implemented interface) and properties typed directly as IEnumerable<T>. + /// If is a generic collection, returns the element type. Handles both concrete collections (where IEnumerable is an + /// implemented interface) and properties typed directly as IEnumerable<T>. /// let tryUnwrapEnumerableElement (t : Type) : Type voption = let isEnumerableInterface (i : Type) = @@ -65,13 +60,10 @@ module TypeCoercion = |> ValueOption.map (fun i -> i.GetGenericArguments()[0]) /// - /// Suffixes the middleware's parser preserves on FieldFilter.FieldName for scalar - /// operators (e.g. meetingId_eq, validFrom_gte). They must be stripped before - /// resolving the actual CLR property. - /// - /// These correspond to the lowercase variants produced after Phase 2 parsing in - /// SchemaDefinitions.parseFieldCondition. Longer suffixes are listed first to prevent - /// shorter ones (e.g. _gt) from incorrectly matching longer ones (e.g. _gte). + /// Suffixes the middleware's parser preserves on FieldFilter.FieldName for scalar operators (e.g. meetingId_eq, + /// validFrom_gte). They must be stripped before resolving the actual CLR property. + /// These correspond to the lowercase variants produced after Phase 2 parsing in SchemaDefinitions.parseFieldCondition. Longer suffixes are + /// listed first to prevent shorter ones (e.g. _gt) from incorrectly matching longer ones (e.g. _gte). /// let operatorSuffixes = [| @@ -109,108 +101,59 @@ module TypeCoercion = |> ValueOption.map (fun s -> fieldName.Substring (0, fieldName.Length - s.Length)) |> ValueOption.defaultValue fieldName - // Cached type references for coercion - let private guidType = typeof - let private dateTimeOffsetType = typeof - let private dateTimeType = typeof - let private dateOnlyType = typeof - let private timeOnlyType = typeof - /// - /// Built-in type coercers for common CLR types. Each coercer takes a boxed value - /// and attempts to parse it (typically from a string) into the target type. + /// Converts a boxed GraphQL scalar primitive to its JSON text representation so that can produce the + /// correct CLR value. Strings and enum-like values are JSON-quoted ("value"); numbers and booleans are emitted as raw JSON tokens. /// - let private builtInCoercers : ImmutableDictionary obj voption> = - let tryParseString (tryParse : string -> bool * 'T) (value : obj) : obj voption = - match value with - | :? string as s -> - match tryParse s with - | true, result -> ValueSome (box result) - | false, _ -> ValueNone - | _ -> ValueNone - - seq { - kvp guidType (tryParseString Guid.TryParse) - kvp dateTimeOffsetType (tryParseString DateTimeOffset.TryParse) - kvp dateTimeType (tryParseString DateTime.TryParse) - kvp dateOnlyType (tryParseString DateOnly.TryParse) - kvp timeOnlyType (tryParseString TimeOnly.TryParse) - } - |> ImmutableDictionary.CreateRange - + let private toJsonString (value : obj) : string voption = + match value with + | :? string as s -> ValueSome $"\"{JsonEncodedText.Encode(s)}\"" + | :? bool as b -> ValueSome (if b then "true" else "false") + | :? int64 as n -> ValueSome (string n) + | :? int as n -> ValueSome (string n) + | :? double as n -> ValueSome (sprintf "%g" n) + | :? float32 as n -> ValueSome (sprintf "%g" n) + | :? decimal as n -> ValueSome (string n) + | _ -> ValueNone + + // Suppress nullness warnings for the obj / objnull mixture. +#nowarn "3261" /// - /// Tries to coerce a JSON-parsed primitive value (typically a ) into the - /// CLR . Supports , , - /// , , , and single-case F# DUs around any - /// of the above. Multi-case DUs with fieldless cases are also supported (matches case name - /// case-insensitively). + /// Tries to coerce a value into using STJ deserialization. Primitives are first rendered as a JSON string via + /// then parsed with and deserialized. Already-correct values pass through unchanged. /// - // Suppress nullness warnings for the obj / objnull mixture: JSON values can theoretically - // be null but in our middleware path the caller always boxes a non-null primitive. - #nowarn "3261" - let rec tryCoerceValue (customCoercers : FilterValueCoercer list) (targetType : Type) (value : obj | null) : obj voption = + let tryCoerceValue (jsonOptions : JsonSerializerOptions voption) (targetType : Type) (value : objnull) : obj voption = if isNull value then ValueNone elif targetType.IsInstanceOfType value then - // Fast path: already the right type. ValueSome value else - // Try custom coercers first - let customResult = - customCoercers - |> List.vtryPick (fun coercer -> coercer targetType value) - - match customResult with - | ValueSome coerced -> ValueSome coerced - | ValueNone -> - // Try built-in coercers from the static dictionary - match builtInCoercers.TryGetValue targetType with - | true, coercer -> coercer value - | false, _ -> - // F# DU handling - if FSharpType.IsUnion (targetType, unionBindFlags) then - let cases = FSharpType.GetUnionCases (targetType, unionBindFlags) - if cases.Length = 1 then - // Single-case DU wrapping: unwrap one layer and recurse. - let case = cases[0] - let fields = case.GetFields () - if fields.Length = 1 then - let innerType = fields[0].PropertyType - match tryCoerceValue customCoercers innerType value with - | ValueSome innerVal -> - ValueSome (FSharpValue.MakeUnion (case, [| innerVal |], unionBindFlags)) - | ValueNone -> ValueNone - else - ValueNone - else - // Multi-case DU: if the value is a string matching a fieldless case, create that case. - match value with - | :? string as str -> - cases - |> Array.vtryFind (fun c -> - c.GetFields().Length = 0 - && String.Equals (c.Name, str, StringComparison.OrdinalIgnoreCase)) - |> ValueOption.map (fun c -> FSharpValue.MakeUnion (c, [||], unionBindFlags)) - | _ -> ValueNone - else - ValueNone + match toJsonString value with + | ValueNone -> ValueNone + | ValueSome json -> + try + let opts = jsonOptions |> ValueOption.defaultValue JsonSerializerOptions.Default + use doc = JsonDocument.Parse json + doc.Deserialize (targetType, opts) |> ValueSome + with _ -> + ValueNone /// - /// Coerces an entire tree recursively by resolving the - /// entities's properties and converting filter values into the property's CLR type. + /// Coerces an entire tree recursively by resolving the entities's properties and converting filter values into the + /// property's CLR type. /// - let rec coerceFilter (customCoercers : FilterValueCoercer list) (entityType : Type) (filter : ObjectListFilter) : ObjectListFilter = + let rec coerceFilter (jsonOptions : JsonSerializerOptions voption) (entityType : Type) (filter : ObjectListFilter) : ObjectListFilter = match filter with - | And (l, r) -> And (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r) - | Or (l, r) -> Or (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r) - | Not f -> Not (coerceFilter customCoercers entityType f) + | And (l, r) -> And (coerceFilter jsonOptions entityType l, coerceFilter jsonOptions entityType r) + | Or (l, r) -> Or (coerceFilter jsonOptions entityType l, coerceFilter jsonOptions entityType r) + | Not f -> Not (coerceFilter jsonOptions entityType f) | OfTypes _ -> filter | Equals (ff, cmp) -> match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with | null -> filter | prop -> let unwrapped = unwrapOption prop.PropertyType - match tryCoerceValue customCoercers unwrapped (box ff.Value) with + match tryCoerceValue jsonOptions unwrapped (box ff.Value) with | ValueNone -> filter | ValueSome coerced -> Equals ({ ff with Value = coerced :?> IComparable }, cmp) | GreaterThan ff @@ -221,22 +164,7 @@ module TypeCoercion = | null -> filter | prop -> let unwrapped = unwrapOption prop.PropertyType - // For comparison operators, if the property is a single-case DU, coerce to the - // inner type only — not the DU itself. buildFilterExpr handles the cast via - // unsafeConvertTo, and the DU's op_GreaterThan etc. take the inner primitive. - let coercionTarget = - match tryUnwrapOption unwrapped with - | ValueSome inner -> inner // already unwrapped above, shouldn't occur - | ValueNone -> - if FSharpType.IsUnion (unwrapped, unionBindFlags) then - let cases = FSharpType.GetUnionCases (unwrapped, unionBindFlags) - if cases.Length = 1 then - let fields = cases[0].GetFields () - if fields.Length = 1 then fields[0].PropertyType - else unwrapped - else unwrapped - else unwrapped - match tryCoerceValue customCoercers coercionTarget (box ff.Value) with + match tryCoerceValue jsonOptions unwrapped (box ff.Value) with | ValueNone -> filter | ValueSome coerced -> let coercedField = { ff with Value = coerced :?> IComparable } @@ -251,21 +179,14 @@ module TypeCoercion = | null -> filter | prop -> let unwrapped = unwrapOption prop.PropertyType - let coercedList = - ff.Value - |> List.choose (fun item -> - match tryCoerceValue customCoercers unwrapped item with - | ValueSome coerced -> Some coerced - | ValueNone -> None) + let coercedList = ff.Value |> List.vchoose (tryCoerceValue jsonOptions unwrapped) In { ff with Value = coercedList } | StartsWith (ff, cmp) | EndsWith (ff, cmp) as originalFilter -> match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with | null -> filter | _ -> - // The pattern argument for string operators is always a plain string — - // never coerce it into the member's DU type. - match tryCoerceValue customCoercers stringType (box ff.Value) with + match tryCoerceValue jsonOptions stringType (box ff.Value) with | ValueNone -> filter | ValueSome coerced -> let coercedField = { ff with Value = coerced :?> string } @@ -278,13 +199,11 @@ module TypeCoercion = | null -> filter | prop -> let unwrapped = unwrapOption prop.PropertyType - // For enumerable members coerce to the element type; for string-like members - // keep the pattern value as a plain string (same reasoning as StartsWith/EndsWith). let coercionTarget = match tryUnwrapEnumerableElement unwrapped with | ValueSome elementType -> elementType | ValueNone -> stringType - match tryCoerceValue customCoercers coercionTarget (box ff.Value) with + match tryCoerceValue jsonOptions coercionTarget (box ff.Value) with | ValueNone -> filter | ValueSome coerced -> Contains ({ ff with Value = coerced :?> IComparable }, cmp) | FilterField ff -> @@ -295,4 +214,4 @@ module TypeCoercion = let nestedType = tryUnwrapEnumerableElement unwrapped |> ValueOption.defaultValue unwrapped - FilterField { FieldName = ff.FieldName; Value = coerceFilter customCoercers nestedType ff.Value } + FilterField { FieldName = ff.FieldName; Value = coerceFilter jsonOptions nestedType ff.Value } diff --git a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj index 1bc224559..e6d4ac250 100644 --- a/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj +++ b/tests/FSharp.Data.GraphQL.Tests/FSharp.Data.GraphQL.Tests.fsproj @@ -75,8 +75,11 @@ - - + + + + + diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqGenerateTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs similarity index 100% rename from tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqGenerateTests.fs rename to tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs similarity index 100% rename from tests/FSharp.Data.GraphQL.Tests/ObjectListFilterLinqTests.fs rename to tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs new file mode 100644 index 000000000..9d8d12628 --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs @@ -0,0 +1,239 @@ +module FSharp.Data.GraphQL.Tests.TypeCoercionFilterTests + +open Xunit +open FSharp.Data.GraphQL.Shared +open FSharp.Data.GraphQL.Server.Middleware +open FSharp.Data.GraphQL.Server.Middleware.ObjectListFilter +open FSharp.Data.GraphQL.Tests.TypeCoercionCommon + +// ────────────────────────────────────────────────────────────────────────────── +// Equals operator +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces string to Guid for Equals`` () = + let filter = Equals ({ FieldName = "guidField"; Value = "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces string to CLR enum for Equals`` () = + let filter = Equals ({ FieldName = "color"; Value = "Green" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces int to CLR enum for Equals`` () = + let filter = Equals ({ FieldName = "color"; Value = 2 }, null) // Blue = 2 + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter coerces string to DU-as-enum for Equals`` () = + let filter = Equals ({ FieldName = "status"; Value = "Active" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces string to single-case DU wrapping string for Equals`` () = + let filter = Equals ({ FieldName = "wrappedName"; Value = "Bob" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces int to single-case DU wrapping int for Equals`` () = + let filter = Equals ({ FieldName = "wrappedScore"; Value = 30 }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter coerces int64 to single-case DU wrapping int64 for Equals`` () = + let filter = Equals ({ FieldName = "wrappedLong"; Value = 200L }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter coerces string to single-case DU wrapping Guid for Equals`` () = + let filter = Equals ({ FieldName = "wrappedGuid"; Value = "cccccccc-cccc-cccc-cccc-cccccccccccc" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter passes through bool for Equals`` () = + let filter = Equals ({ FieldName = "isActive"; Value = true }, null) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.forall (fun e -> e.IsActive) |> equals true + +// ────────────────────────────────────────────────────────────────────────────── +// comparison operators (GreaterThan / LessThan) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces int to decimal for GreaterThanOrEqual`` () = + // Score: Alice=100, Bob=200, Charlie=300. >= 200 -> Bob and Charlie + let filter = GreaterThanOrEqual { FieldName = "score"; Value = 200 } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +[] +let ``coerceFilter coerces string to DateTime for GreaterThan`` () = + // CreatedAt: Alice=2024-01-01, Bob=2024-02-01, Charlie=2024-03-01. > 2024-01-15 + let filter = GreaterThan { FieldName = "createdAt"; Value = "2024-01-15T00:00:00" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +[] +let ``coerceFilter coerces string to DateOnly for LessThan`` () = + // BirthDate: Alice=1990-05-15, Bob=1985-08-20, Charlie=2000-12-31. < 2000-01-01 + let filter = LessThan { FieldName = "birthDate"; Value = "2000-01-01" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Bob" ] + +[] +let ``coerceFilter coerces string to TimeOnly for GreaterThan`` () = + // AlarmTime: Alice=08:00, Bob=09:00, Charlie=10:00. > 08:30 -> Bob and Charlie + let filter = GreaterThan { FieldName = "alarmTime"; Value = "08:30:00" } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] + +// ────────────────────────────────────────────────────────────────────────────── +// option / voption field unwrapping +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces string through option wrapper for Equals`` () = + let filter = Equals ({ FieldName = "optionName"; Value = "Alice" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces int through voption wrapper for Equals`` () = + let filter = Equals ({ FieldName = "vOptionId"; Value = 3 }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +// ────────────────────────────────────────────────────────────────────────────── +// In operator +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces In operator values to CLR enum`` () = + let filter = In { FieldName = "color"; Value = [ box "Red"; box "Blue" ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces In operator values to DU-as-enum`` () = + let filter = In { FieldName = "status"; Value = [ box "Active"; box "Pending" ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces In operator values to Guid`` () = + let filter = + In { + FieldName = "guidField" + Value = [ + box "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" + box "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb" + ] + } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Bob" ] + +[] +let ``coerceFilter coerces In operator values to single-case DU wrapping int`` () = + let filter = In { FieldName = "wrappedScore"; Value = [ box 10; box 30 ] } + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +// ────────────────────────────────────────────────────────────────────────────── +// string operators +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter handles StartsWith for plain string field`` () = + let filter = StartsWith ({ FieldName = "name"; Value = "Al" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter handles EndsWith for plain string field`` () = + let filter = EndsWith ({ FieldName = "name"; Value = "ie" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Charlie" + +[] +let ``coerceFilter handles Contains for plain string field`` () = + let filter = Contains ({ FieldName = "name"; Value = "ob" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Bob" + +[] +let ``coerceFilter handles Contains for list field (element membership)`` () = + // Tags: Alice=["admin";"user"], Bob=["user"], Charlie=["moderator";"user"] + let filter = Contains ({ FieldName = "tags"; Value = "admin" }, null) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter handles Contains for list field matching multiple entities`` () = + let filter = Contains ({ FieldName = "tags"; Value = "user" }, null) + let result = applyFilter filter + result |> List.length |> equals 3 + +// ────────────────────────────────────────────────────────────────────────────── +// AND / OR / NOT combinators +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``coerceFilter coerces values inside AND`` () = + let filter = + And ( + Equals ({ FieldName = "color"; Value = "Red" }, null), + Equals ({ FieldName = "status"; Value = "Active" }, null) + ) + let result = applyFilter filter + result |> List.length |> equals 1 + (List.head result).Name |> equals "Alice" + +[] +let ``coerceFilter coerces values inside OR`` () = + let filter = + Or ( + Equals ({ FieldName = "color"; Value = "Red" }, null), + Equals ({ FieldName = "color"; Value = "Blue" }, null) + ) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Alice"; "Charlie" ] + +[] +let ``coerceFilter coerces values inside NOT`` () = + let filter = Not (Equals ({ FieldName = "status"; Value = "Active" }, null)) + let result = applyFilter filter + result |> List.length |> equals 2 + result |> List.map (fun e -> e.Name) |> List.sort |> equals [ "Bob"; "Charlie" ] diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs new file mode 100644 index 000000000..17161ae15 --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs @@ -0,0 +1,135 @@ +module FSharp.Data.GraphQL.Tests.TypeCoercionCommon + +open System +open System.Linq +open System.Text.Json +open FSharp.Data.GraphQL.Shared +open FSharp.Data.GraphQL.Server.Middleware + +// ────────────────────────────────────────────────────────────────────────────── +// Test types +// ────────────────────────────────────────────────────────────────────────────── + +/// CLR enum — coerced from string via JsonStringEnumConverter or from int via default STJ. +type Color = + | Red = 0 + | Green = 1 + | Blue = 2 + +/// Multi-case fieldless DU (DU-as-enum) — coerced from string via +/// FSharp.SystemTextJson UnwrapFieldlessTags. +type Status = + | Active + | Inactive + | Pending + +/// Single-case DU wrapping a string — coerced via FSharp.SystemTextJson UnwrapSingleCaseUnions. +type WrappedString = WrappedString of string + +/// Single-case DU wrapping an int. +type WrappedInt = WrappedInt of int + +/// Single-case DU wrapping an int64. +type WrappedInt64 = WrappedInt64 of int64 + +/// Single-case DU wrapping a Guid. +type WrappedGuid = WrappedGuid of Guid + +/// Entity used in coerceFilter integration tests. +type CoercionEntity = { + Id: int + Name: string + Status: Status + Color: Color + GuidField: Guid + WrappedName: WrappedString + WrappedScore: WrappedInt + WrappedLong: WrappedInt64 + WrappedGuid: WrappedGuid + CreatedAt: DateTime + BirthDate: DateOnly + AlarmTime: TimeOnly + Score: decimal + IsActive: bool + Tags: string list + OptionName: string option + VOptionId: int voption +} + +// ────────────────────────────────────────────────────────────────────────────── +// Shared test infrastructure +// ────────────────────────────────────────────────────────────────────────────── + +/// Full serializer options including FSharp.SystemTextJson (DU coercion) and +/// JsonStringEnumConverter (CLR enum coercion). +let jsonOptions = ValueSome (Json.getSerializerOptions Seq.empty) + +/// No options — uses STJ defaults; sufficient for primitives, Guid, date/time. +let noOptions : JsonSerializerOptions voption = ValueNone + +let filterOptions = + ObjectListFilterLinqOptions (Json.getSerializerOptions Seq.empty) + +let testData = + [| + { + Id = 1 + Name = "Alice" + Status = Active + Color = Color.Red + GuidField = Guid.Parse "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa" + WrappedName = WrappedString "Alice" + WrappedScore = WrappedInt 10 + WrappedLong = WrappedInt64 100L + WrappedGuid = WrappedGuid (Guid.Parse "aaaaaaaa-aaaa-aaaa-aaaa-aaaaaaaaaaaa") + CreatedAt = DateTime (2024, 1, 1) + BirthDate = DateOnly (1990, 5, 15) + AlarmTime = TimeOnly (8, 0) + Score = 100m + IsActive = true + Tags = [ "admin"; "user" ] + OptionName = Some "Alice" + VOptionId = ValueSome 1 + } + { + Id = 2 + Name = "Bob" + Status = Inactive + Color = Color.Green + GuidField = Guid.Parse "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb" + WrappedName = WrappedString "Bob" + WrappedScore = WrappedInt 20 + WrappedLong = WrappedInt64 200L + WrappedGuid = WrappedGuid (Guid.Parse "bbbbbbbb-bbbb-bbbb-bbbb-bbbbbbbbbbbb") + CreatedAt = DateTime (2024, 2, 1) + BirthDate = DateOnly (1985, 8, 20) + AlarmTime = TimeOnly (9, 0) + Score = 200m + IsActive = false + Tags = [ "user" ] + OptionName = None + VOptionId = ValueNone + } + { + Id = 3 + Name = "Charlie" + Status = Pending + Color = Color.Blue + GuidField = Guid.Parse "cccccccc-cccc-cccc-cccc-cccccccccccc" + WrappedName = WrappedString "Charlie" + WrappedScore = WrappedInt 30 + WrappedLong = WrappedInt64 300L + WrappedGuid = WrappedGuid (Guid.Parse "cccccccc-cccc-cccc-cccc-cccccccccccc") + CreatedAt = DateTime (2024, 3, 1) + BirthDate = DateOnly (2000, 12, 31) + AlarmTime = TimeOnly (10, 0) + Score = 300m + IsActive = true + Tags = [ "moderator"; "user" ] + OptionName = Some "Charlie" + VOptionId = ValueSome 3 + } + |] + +let applyFilter (filter : ObjectListFilter) = + filter.ApplyTo (testData.AsQueryable (), filterOptions) |> Seq.toList diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs new file mode 100644 index 000000000..8902263a6 --- /dev/null +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs @@ -0,0 +1,209 @@ +module FSharp.Data.GraphQL.Tests.TypeCoercionValueTests + +open Xunit +open System +open FSharp.Data.GraphQL.Server.Middleware +open FSharp.Data.GraphQL.Tests.TypeCoercionCommon + +// ────────────────────────────────────────────────────────────────────────────── +// pass-through (value already has the target type) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue passes through string`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "hello") + |> wantValueSome |> equals (box "hello") + +[] +let ``tryCoerceValue passes through int`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 42) + |> wantValueSome |> equals (box 42) + +[] +let ``tryCoerceValue passes through bool`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box true) + |> wantValueSome |> equals (box true) + +[] +let ``tryCoerceValue passes through Guid`` () = + let g = Guid.NewGuid () + TypeCoercion.tryCoerceValue noOptions typeof (box g) + |> wantValueSome |> equals (box g) + +[] +let ``tryCoerceValue passes through decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 9.99m) + |> wantValueSome |> equals (box 9.99m) + +[] +let ``tryCoerceValue passes through DateTime`` () = + let dt = DateTime (2024, 6, 1) + TypeCoercion.tryCoerceValue noOptions typeof (box dt) + |> wantValueSome |> equals (box dt) + +// ────────────────────────────────────────────────────────────────────────────── +// null → ValueNone +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue returns ValueNone for null`` () = + TypeCoercion.tryCoerceValue noOptions typeof null + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// numeric widening / narrowing +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces int to int64`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 42) + |> wantValueSome |> equals (box 42L) + +[] +let ``tryCoerceValue returns ValueNone for string-to-int (STJ rejects quoted number)`` () = + // STJ does not coerce quoted strings to numbers without JsonNumberHandling.AllowReadingFromString + TypeCoercion.tryCoerceValue noOptions typeof (box "99") + |> wantValueNone + +[] +let ``tryCoerceValue returns ValueNone for string-to-int64 (STJ rejects quoted number)`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "123456789") + |> wantValueNone + +[] +let ``tryCoerceValue coerces double to decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 3.14) + |> wantValueSome |> equals (box 3.14m) + +[] +let ``tryCoerceValue coerces int to decimal`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 200) + |> wantValueSome |> equals (box 200m) + +[] +let ``tryCoerceValue passes through bool (already correct type)`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box true) + |> wantValueSome |> equals (box true) + +// ────────────────────────────────────────────────────────────────────────────── +// string → Guid +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to Guid`` () = + let g = Guid.Parse "550e8400-e29b-41d4-a716-446655440000" + TypeCoercion.tryCoerceValue noOptions typeof (box "550e8400-e29b-41d4-a716-446655440000") + |> wantValueSome |> equals (box g) + +[] +let ``tryCoerceValue returns ValueNone for invalid Guid string`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "not-a-guid") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// string → date/time types (native STJ support) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces ISO string to DateTime`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01T00:00:00") + |> wantValueSome |> equals (box (DateTime (2024, 6, 1, 0, 0, 0))) + +[] +let ``tryCoerceValue coerces ISO string to DateTimeOffset`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01T12:00:00+00:00") + |> wantValueSome |> ignore + +[] +let ``tryCoerceValue coerces ISO string to DateOnly`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "2024-06-01") + |> wantValueSome |> equals (box (DateOnly (2024, 6, 1))) + +[] +let ``tryCoerceValue coerces ISO string to TimeOnly`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box "14:30:00") + |> wantValueSome |> equals (box (TimeOnly (14, 30, 0))) + +// ────────────────────────────────────────────────────────────────────────────── +// CLR enum +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces int to CLR enum without jsonOptions`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box 2) + |> wantValueSome |> equals (box Color.Blue) + +[] +let ``tryCoerceValue coerces string to CLR enum with jsonOptions (JsonStringEnumConverter)`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Green") + |> wantValueSome |> equals (box Color.Green) + +[] +let ``tryCoerceValue returns ValueNone for string CLR enum without jsonOptions`` () = + // Without JsonStringEnumConverter, STJ rejects string enum tokens by default + TypeCoercion.tryCoerceValue noOptions typeof (box "Red") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// single-case DU (requires FSharp.SystemTextJson UnwrapSingleCaseUnions) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to single-case DU wrapping string`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "hello") + |> wantValueSome |> equals (box (WrappedString "hello")) + +[] +let ``tryCoerceValue coerces int to single-case DU wrapping int`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box 42) + |> wantValueSome |> equals (box (WrappedInt 42)) + +[] +let ``tryCoerceValue coerces int64 to single-case DU wrapping int64`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box 999L) + |> wantValueSome |> equals (box (WrappedInt64 999L)) + +[] +let ``tryCoerceValue coerces string to single-case DU wrapping Guid`` () = + let g = Guid.Parse "550e8400-e29b-41d4-a716-446655440000" + TypeCoercion.tryCoerceValue jsonOptions typeof (box "550e8400-e29b-41d4-a716-446655440000") + |> wantValueSome |> equals (box (WrappedGuid g)) + +[] +let ``tryCoerceValue returns ValueNone for single-case DU without jsonOptions`` () = + // Without FSharp.SystemTextJson, STJ doesn't know how to deserialize DUs + TypeCoercion.tryCoerceValue noOptions typeof (box "hello") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// multi-case fieldless DU / DU-as-enum (requires FSharp.SystemTextJson UnwrapFieldlessTags) +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Active`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Active") + |> wantValueSome |> equals (box Active) + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Inactive`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Inactive") + |> wantValueSome |> equals (box Inactive) + +[] +let ``tryCoerceValue coerces string to multi-case fieldless DU - Pending`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Pending") + |> wantValueSome |> equals (box Pending) + +[] +let ``tryCoerceValue returns ValueNone for unknown multi-case DU case name`` () = + TypeCoercion.tryCoerceValue jsonOptions typeof (box "Unknown") + |> wantValueNone + +// ────────────────────────────────────────────────────────────────────────────── +// unsupported conversion +// ────────────────────────────────────────────────────────────────────────────── + +[] +let ``tryCoerceValue returns ValueNone when source type has no JSON representation`` () = + TypeCoercion.tryCoerceValue noOptions typeof (box (obj ())) + |> wantValueNone From ce93746a9c6aa566917f72503874232121d06fb3 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 00:54:50 +0200 Subject: [PATCH 03/10] =?UTF-8?q?Update=D0=B2=20schema,=20add=20type=20coe?= =?UTF-8?q?rcion=20guide,=20bug=20report,=20tools?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * Added bug report for InputObject array type mismatch with analysis and test cases * Added type coercion guide for ObjectListFilter with usage and API docs * Introduced format-changed-files.ps1 to batch-format changed F# files via Fantomas * Updated schema snapshots for relay-style connections and new scalars * Refactored field_aliases.fsx for relay-style friends connection * Optimized TypeCoercion.fs to use Utf8JsonWriter for value coercion * Added prompt template for automated PR/issue description generation --- .../TypeCoercion.fs | 55 +++++++++++++------ 1 file changed, 37 insertions(+), 18 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs index efcdca1f9..71071f133 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -1,6 +1,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System +open System.Buffers open System.Collections.Generic open System.Reflection open System.Text.Json @@ -102,25 +103,41 @@ module TypeCoercion = |> ValueOption.defaultValue fieldName /// - /// Converts a boxed GraphQL scalar primitive to its JSON text representation so that can produce the - /// correct CLR value. Strings and enum-like values are JSON-quoted ("value"); numbers and booleans are emitted as raw JSON tokens. + /// Writes a boxed GraphQL scalar primitive as a JSON token directly into . Strings become JSON strings; numbers and + /// booleans become raw JSON tokens. Returns true if the value was written; false if the type is unsupported. /// - let private toJsonString (value : obj) : string voption = + let private writeJsonValue (value : obj) (writer : Utf8JsonWriter) : bool = match value with - | :? string as s -> ValueSome $"\"{JsonEncodedText.Encode(s)}\"" - | :? bool as b -> ValueSome (if b then "true" else "false") - | :? int64 as n -> ValueSome (string n) - | :? int as n -> ValueSome (string n) - | :? double as n -> ValueSome (sprintf "%g" n) - | :? float32 as n -> ValueSome (sprintf "%g" n) - | :? decimal as n -> ValueSome (string n) - | _ -> ValueNone + | :? string as s -> + writer.WriteStringValue s + true + | :? bool as b -> + writer.WriteBooleanValue b + true + | :? int64 as n -> + writer.WriteNumberValue n + true + | :? int as n -> + writer.WriteNumberValue n + true + | :? double as n -> + writer.WriteNumberValue n + true + | :? float32 as n -> + writer.WriteNumberValue n + true + | :? decimal as n -> + writer.WriteNumberValue n + true + | _ -> + false // Suppress nullness warnings for the obj / objnull mixture. #nowarn "3261" /// - /// Tries to coerce a value into using STJ deserialization. Primitives are first rendered as a JSON string via - /// then parsed with and deserialized. Already-correct values pass through unchanged. + /// Tries to coerce a value into using STJ deserialization. Primitives are written directly as JSON bytes via + /// into an , then deserialized from ReadOnlySpan<byte>. + /// Already-correct values pass through unchanged. No intermediate string or is allocated. /// let tryCoerceValue (jsonOptions : JsonSerializerOptions voption) (targetType : Type) (value : objnull) : obj voption = if isNull value then @@ -128,13 +145,15 @@ module TypeCoercion = elif targetType.IsInstanceOfType value then ValueSome value else - match toJsonString value with - | ValueNone -> ValueNone - | ValueSome json -> + let buffer = ArrayBufferWriter 64 + use writer = new Utf8JsonWriter (buffer) + if not (writeJsonValue value writer) then + ValueNone + else + writer.Flush () try let opts = jsonOptions |> ValueOption.defaultValue JsonSerializerOptions.Default - use doc = JsonDocument.Parse json - doc.Deserialize (targetType, opts) |> ValueSome + JsonSerializer.Deserialize (buffer.WrittenSpan, targetType, opts) |> ValueSome with _ -> ValueNone From c61a0043b6a84474ca3161525814f7789b34a721 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 13:49:41 +0200 Subject: [PATCH 04/10] Rebase fix --- .../FSharp.Data.GraphQL.Server.Middleware.fsproj | 1 - src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs | 4 ++++ .../SchemaDefinitions.fs | 2 +- 3 files changed, 5 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj index 7ceaefb05..fd2591309 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj +++ b/src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj @@ -22,7 +22,6 @@ - diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index a02c73ce0..2f53e3906 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -40,6 +40,10 @@ open System.Runtime.InteropServices type private CompareDiscriminatorExpression<'T, 'D> = Expression> +// ──────────────────────────────────────────────────────────────────────────── +// Type Coercion Support +// ──────────────────────────────────────────────────────────────────────────── + /// /// Validation error raised when an incoming cannot be /// translated to a LINQ expression against the queried entity type. diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs index efd594a8e..2fd6951dd 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs @@ -183,7 +183,7 @@ let ObjectListFilterType : InputCustomDefinition = { (String.concat " " [ - "The ObjectListFilter value represents field filters for object lists." + "The `ObjectListFilter` value represents field filters for object lists." "Lowercase string suffixes such as `_starts_with`/`_sw`, `_ends_with`/`_ew`, `_contains` (no shorthand), and `_equals`/`_eq` are case-insensitive when applied to string fields." "Capitalized string suffixes such as `_Starts_With`/`_SW`, `_Ends_With`/`_EW`, `_Contains` (no shorthand), and `_Equals`/`_EQ` are case-sensitive when applied to string fields." "Comparison suffixes such as `_gt`, `_gte`, `_lt`, `_lte`, and `_in` are also supported." From 0e536dbd863f980b326ebef70b8355b8aa0fef4a Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 14:04:11 +0200 Subject: [PATCH 05/10] Update filters to use `CurrentCulture` string comparison Updated all string comparison operations in `ObjectListFilter` and filter parsing logic to use `StringComparer.CurrentCulture` or `StringComparer.CurrentCultureIgnoreCase` instead of `Ordinal`/`OrdinalIgnoreCase`. Adjusted related test expectations to match. This ensures string-based filters now respect the current culture's case rules. --- .../ObjectListFilterModule.fs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs index 21ca7cdc5..d1120d6fa 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -54,16 +54,16 @@ module ObjectListFilter = let ( !!! ) filter = Not filter /// Creates a new ObjectListFilter representing a case-insensitive EQUALS operation on a string value. - let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + let ( ===~ ) fname (value : string) = Equals ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) /// Creates a new ObjectListFilter representing a case-insensitive STARTS WITH operation on a string value. - let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + let ( =@@~ ) fname (value : string) = StartsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) /// Creates a new ObjectListFilter representing a case-insensitive ENDS WITH operation on a string value. - let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + let ( @@=~ ) fname (value : string) = EndsWith ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) /// Creates a new ObjectListFilter representing a case-insensitive CONTAINS operation on a string value. - let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.OrdinalIgnoreCase) + let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) let private genericWhereMethod = let queryableType = typeof From 2b531ac36b3ab768193567506cb407ead145f8f6 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 15:18:36 +0200 Subject: [PATCH 06/10] Rebase fixes --- .../ObjectListFilter.fs | 30 ++++++++++++++++--- .../ObjectListFilterModule.fs | 3 +- 2 files changed, 27 insertions(+), 6 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index 2f53e3906..5fd41a897 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -40,10 +40,6 @@ open System.Runtime.InteropServices type private CompareDiscriminatorExpression<'T, 'D> = Expression> -// ──────────────────────────────────────────────────────────────────────────── -// Type Coercion Support -// ──────────────────────────────────────────────────────────────────────────── - /// /// Validation error raised when an incoming cannot be /// translated to a LINQ expression against the queried entity type. @@ -54,6 +50,32 @@ type ObjectListFilterValidationException (message : string, [] extensi /// /// Optional configuration for LINQ translation including discriminator handling. /// +/// +/// // discriminator custom condition +/// let result () = +/// queryable.Apply( +/// filter, +/// ObjectListFilterLinqOptions ( +/// (fun entity discriminator -> entity.Discriminator.StartsWith discriminator), +/// (function +/// | t when Type.(=)(t, typeof) -> "cat+v1" +/// | t when Type.(=)(t, typeof) -> "dog+v1") +/// ) +/// ) +/// +/// +/// // discriminator equals +/// let result () = +/// queryable.Apply( +/// filter, +/// ObjectListFilterLinqOptions ( +/// (fun entity -> entity.Discriminator), +/// (function +/// | t when Type.(=)(t, typeof) -> "cat" +/// | t when Type.(=)(t, typeof) -> "dog") +/// ) +/// ) +/// type ObjectListFilterLinqOptions<'T, 'D> ( [] compareDiscriminator : CompareDiscriminatorExpression<'T, 'D> | null, diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs index d1120d6fa..158867a05 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -66,8 +66,7 @@ module ObjectListFilter = let ( @=@~ ) fname (value : string) = Contains ({ FieldName = fname; Value = value }, StringComparer.CurrentCultureIgnoreCase) let private genericWhereMethod = - let queryableType = typeof - queryableType.GetMethods () + typeof.GetMethods () |> Seq.where (fun m -> m.Name = "Where") |> Seq.find (fun m -> let parameters = m.GetParameters () From 46e46b3f76e5b3f651f0867d4e89fa838564575d Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 16:11:58 +0200 Subject: [PATCH 07/10] Removed unnecessary `ObjectListFilterValidationException` --- .../ObjectListFilter.fs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index 5fd41a897..85b391109 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -3,7 +3,6 @@ namespace FSharp.Data.GraphQL.Server.Middleware open System open System.Collections open System.Text.Json -open FSharp.Data.GraphQL /// A filter definition for a field value. type FieldFilter<'Val> = { FieldName : string; Value : 'Val } @@ -34,19 +33,11 @@ type ObjectListFilter = | OfTypes of Type list | FilterField of FieldFilter -open System.Collections.Generic open System.Linq.Expressions open System.Runtime.InteropServices type private CompareDiscriminatorExpression<'T, 'D> = Expression> -/// -/// Validation error raised when an incoming cannot be -/// translated to a LINQ expression against the queried entity type. -/// -type ObjectListFilterValidationException (message : string, [] extensions : Dictionary | null) = - inherit GQLMessageExceptionBase (ErrorKind.Validation, message, extensions) - /// /// Optional configuration for LINQ translation including discriminator handling. /// From 01fb5ee4af1e7dbf188a9a6facff6c10ddba83a6 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 16:23:52 +0200 Subject: [PATCH 08/10] Added test traits --- .../ObjectListFilterLinqGenerateTests.fs | 4 +++- .../ObjectListFilter/ObjectListFilterLinqTests.fs | 4 +++- .../ObjectListFilter/TypeCoercionFilterTests.fs | 7 +++---- .../ObjectListFilter/TypeCoercionTests.Common.fs | 3 ++- .../ObjectListFilter/TypeCoercionValueTests.fs | 5 +++-- .../FSharp.Data.GraphQL.Tests/SelectLinqTests.fs | 1 + tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs | 15 +++++++++++++++ 7 files changed, 30 insertions(+), 9 deletions(-) diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs index c8a392009..cfad4284b 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs @@ -1,4 +1,6 @@ -module FSharp.Data.GraphQL.Tests.ObjectListFilterLinqGenerateTests +[] +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.Linq.GenerateTests open Xunit open System diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs index bdd14b703..133e24a0c 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqTests.fs @@ -1,4 +1,6 @@ -module FSharp.Data.GraphQL.Tests.ObjectListFilterLinqTests +[] +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.Linq.Tests open Xunit open System diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs index 9d8d12628..b137f3daf 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionFilterTests.fs @@ -1,10 +1,9 @@ -module FSharp.Data.GraphQL.Tests.TypeCoercionFilterTests +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.FilterTests open Xunit -open FSharp.Data.GraphQL.Shared open FSharp.Data.GraphQL.Server.Middleware -open FSharp.Data.GraphQL.Server.Middleware.ObjectListFilter -open FSharp.Data.GraphQL.Tests.TypeCoercionCommon +open FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common // ────────────────────────────────────────────────────────────────────────────── // Equals operator diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs index 17161ae15..d6d377563 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionTests.Common.fs @@ -1,4 +1,5 @@ -module FSharp.Data.GraphQL.Tests.TypeCoercionCommon +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common open System open System.Linq diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs index 8902263a6..123d354c2 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/TypeCoercionValueTests.fs @@ -1,9 +1,10 @@ -module FSharp.Data.GraphQL.Tests.TypeCoercionValueTests +[] +module FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.ValueTests open Xunit open System open FSharp.Data.GraphQL.Server.Middleware -open FSharp.Data.GraphQL.Tests.TypeCoercionCommon +open FSharp.Data.GraphQL.Tests.ObjectListFilter.TypeCoercion.Common // ────────────────────────────────────────────────────────────────────────────── // pass-through (value already has the target type) diff --git a/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs b/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs index dcad59739..409c0a5a7 100644 --- a/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/SelectLinqTests.fs @@ -1,5 +1,6 @@ // The MIT License (MIT) // Copyright (c) 2016 Bazinga Technologies Inc +[] module FSharp.Data.GraphQL.Tests.LinqTests open Xunit diff --git a/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs b/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs index 4d3cdc491..f2c45c86b 100644 --- a/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs +++ b/tests/FSharp.Data.GraphQL.Tests/TestAttributes.fs @@ -20,3 +20,18 @@ type UseInvariantCultureAttribute() = override _.After (methodUnderTest) = CultureInfo.CurrentUICulture <- _originalUICulture CultureInfo.CurrentCulture <- _originalCulture + +namespace Tests + +module TraitType = + + [] + let Category = "Category" + +module TraitName = + + [] + let Linq = "LINQ" + + [] + let ObjectListFilter = "ObjectListFilter" From af5eeb222053efa84a840d42fd7c5269e35fd7de Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 18:17:34 +0200 Subject: [PATCH 09/10] AI review fixes --- .../ObjectListFilter.fs | 1 + .../ObjectListFilterModule.fs | 8 ++++---- .../TypeCoercion.fs | 11 +++++++---- 3 files changed, 12 insertions(+), 8 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs index 85b391109..27fff9341 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs @@ -7,6 +7,7 @@ open System.Text.Json /// A filter definition for a field value. type FieldFilter<'Val> = { FieldName : string; Value : 'Val } +/// /// A filter definition for an object list. /// /// diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs index 158867a05..3fe2a5fe3 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs @@ -246,11 +246,11 @@ module ObjectListFilter = | NonEnumerableCast ``type`` -> Expression.LessThanOrEqual ((unsafeConvertTo ``type`` ``member``), Expression.Constant f.Value) | StartsWith (f, comparer) -> let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture Expression.Call (normalizeStringMemberExpr ``member``, StringStartsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) | EndsWith (f, comparer) -> let ``member`` = Expression.PropertyOrField (param, f.FieldName) - let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture Expression.Call (normalizeStringMemberExpr ``member``, StringEndsWithMethod, Expression.Constant f.Value, Expression.Constant comparison) | Contains (f, comparer) -> @@ -289,7 +289,7 @@ module ObjectListFilter = | :? FieldInfo as field when field.FieldType |> isEnumerable -> callContains field.FieldType | _ -> let unwrappedValue = Helpers.unwrap f.Value - let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.Ordinal + let comparison = comparerToStringComparison comparer |> ValueOption.defaultValue StringComparison.CurrentCulture Expression.Call (normalizeStringMemberExpr ``member``, StringContainsMethod, Expression.Constant (unwrappedValue :?> string, stringType), Expression.Constant comparison) | In f when not (f.Value.IsEmpty) -> let ``member`` = Expression.PropertyOrField (param, f.FieldName) @@ -404,4 +404,4 @@ module ObjectListFilterExtensions = /// /// member inline query.Apply (filter : ObjectListFilter, [] options : ObjectListFilterLinqOptions<'T, 'D> | null) = - apply options filter query + filter.ApplyTo (query, options) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs index 71071f133..f77f7c595 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -174,7 +174,8 @@ module TypeCoercion = let unwrapped = unwrapOption prop.PropertyType match tryCoerceValue jsonOptions unwrapped (box ff.Value) with | ValueNone -> filter - | ValueSome coerced -> Equals ({ ff with Value = coerced :?> IComparable }, cmp) + | ValueSome (:? IComparable as coerced) -> Equals ({ ff with Value = coerced }, cmp) + | ValueSome _ -> filter | GreaterThan ff | GreaterThanOrEqual ff | LessThan ff @@ -185,14 +186,15 @@ module TypeCoercion = let unwrapped = unwrapOption prop.PropertyType match tryCoerceValue jsonOptions unwrapped (box ff.Value) with | ValueNone -> filter - | ValueSome coerced -> - let coercedField = { ff with Value = coerced :?> IComparable } + | ValueSome (:? IComparable as coerced) -> + let coercedField = { ff with Value = coerced } match originalFilter with | GreaterThan _ -> GreaterThan coercedField | GreaterThanOrEqual _ -> GreaterThanOrEqual coercedField | LessThan _ -> LessThan coercedField | LessThanOrEqual _ -> LessThanOrEqual coercedField | _ -> filter + | ValueSome _ -> filter | In ff -> match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with | null -> filter @@ -224,7 +226,8 @@ module TypeCoercion = | ValueNone -> stringType match tryCoerceValue jsonOptions coercionTarget (box ff.Value) with | ValueNone -> filter - | ValueSome coerced -> Contains ({ ff with Value = coerced :?> IComparable }, cmp) + | ValueSome (:? IComparable as coerced) -> Contains ({ ff with Value = coerced }, cmp) + | ValueSome _ -> filter | FilterField ff -> match entityType.GetProperty (ff.FieldName, propertyBindFlags) with | null -> filter From 47cf92ea0c79fd837b0179ee66bf61d2006164f5 Mon Sep 17 00:00:00 2001 From: Andrii Chebukin Date: Thu, 9 Jul 2026 18:18:00 +0200 Subject: [PATCH 10/10] Fix ObjectListFilter IN coercion behavior and add converter/no-converter tests --- .../TypeCoercion.fs | 24 +++++++++++++++++-- .../ObjectListFilterLinqGenerateTests.fs | 12 ++++++++-- 2 files changed, 32 insertions(+), 4 deletions(-) diff --git a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs index f77f7c595..78cc0f251 100644 --- a/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs +++ b/src/FSharp.Data.GraphQL.Server.Middleware/TypeCoercion.fs @@ -200,8 +200,28 @@ module TypeCoercion = | null -> filter | prop -> let unwrapped = unwrapOption prop.PropertyType - let coercedList = ff.Value |> List.vchoose (tryCoerceValue jsonOptions unwrapped) - In { ff with Value = coercedList } + + let struct (coercedValues, failedValues) = + ff.Value + |> List.fold + (fun struct (coerced, failed) value -> + match tryCoerceValue jsonOptions unwrapped value with + | ValueSome coercedValue -> (coercedValue :: coerced, failed) + | ValueNone -> struct (coerced, value :: failed)) + ([], []) + + match failedValues with + | [] -> In { ff with Value = List.rev coercedValues } + | _ -> + let failedValuesText = + failedValues + |> Seq.rev + |> Seq.map (sprintf "%A") + |> String.concat ", " + + invalidArg + (nameof filter) + ($"Unable to coerce one or more values for '{ff.FieldName}' to '{unwrapped.FullName}'. Uncoerced values: [{failedValuesText}]") | StartsWith (ff, cmp) | EndsWith (ff, cmp) as originalFilter -> match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with diff --git a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs index cfad4284b..5f1030026 100644 --- a/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs +++ b/tests/FSharp.Data.GraphQL.Tests/ObjectListFilter/ObjectListFilterLinqGenerateTests.fs @@ -101,6 +101,7 @@ let cosmosClient = new CosmosClient ("https://localhost:8081/", "C2y6yDjf5/R+ob0N8A7Cgv30VRDJIWEHLM+4QDU5DE2nQ9nDuVTqobD4b8mGGyPMbIZnqyMsEcaGQy67XIw/Jw==", options) let container = cosmosClient.GetContainer ("database", "container") let filterOptions = ObjectListFilterLinqOptions.None +let filterOptionsWithConverters = ObjectListFilterLinqOptions (jsonOptions) [] let ``ObjectListFilter works with Equals operator for ValidStringStruct`` () = @@ -247,13 +248,20 @@ let ``ObjectListFilter works with Contains operator for ValidStringStruct list`` equals queryDefinition.QueryText, """SELECT VALUE root FROM root WHERE ARRAY_CONTAINS(root["validStringStructList"], "athan")""" [] -let ``ObjectListFilter works with In operator for ValidStringStruct list`` () = +let ``ObjectListFilter works with In operator for ValidStringStruct list when converters are provided`` () = let queryable = container.GetItemLinqQueryable () let filter = In { FieldName = "validStringStruct"; Value = [ "athan"; "gaja" ] } - let filterQuery = queryable.Apply (filter, filterOptions) + let filterQuery = queryable.Apply (filter, filterOptionsWithConverters) let queryDefinition = CosmosLinqExtensions.ToQueryDefinition filterQuery equals queryDefinition.QueryText, """SELECT VALUE root FROM root WHERE ARRAY_CONTAINS([ "athan", "gaja" ], root["validStringStruct"])""" +[] +let ``ObjectListFilter works with In operator for ValidStringStruct list when converters are not provided`` () = + let queryable = container.GetItemLinqQueryable () + let filter = In { FieldName = "validStringStruct"; Value = [ "athan"; "gaja" ] } + let ex = Assert.Throws(fun () -> queryable.Apply (filter, filterOptions) |> ignore) + Assert.Contains ("Uncoerced values", ex.Message) + [] let ``ObjectListFilter works with In operator for empty ValidStringStruct list`` () = let queryable = container.GetItemLinqQueryable ()