Skip to content

Commit d3e00fa

Browse files
committed
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
1 parent 9ab3e7c commit d3e00fa

8 files changed

Lines changed: 815 additions & 395 deletions

File tree

src/FSharp.Data.GraphQL.Server.Middleware/FSharp.Data.GraphQL.Server.Middleware.fsproj

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,8 +20,11 @@
2020
</ItemGroup>
2121

2222
<ItemGroup>
23+
<Compile Include="FilterSuffixConstants.fs" />
2324
<Compile Include="ObjectListFilter.fs" />
2425
<Compile Include="FilterSuffixConstants.fs" />
26+
<Compile Include="TypeCoercion.fs" />
27+
<Compile Include="ObjectListFilterModule.fs" />
2528
<Compile Include="TypeSystemExtensions.fs" />
2629
<Compile Include="SchemaDefinitions.fs" />
2730
<Compile Include="MiddlewareDefinitions.fs" />

src/FSharp.Data.GraphQL.Server.Middleware/FilterSuffixConstants.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ let LTSuffix = "_lt"
3131
[<Literal>]
3232
let InSuffix = "_in"
3333

34-
/// Case-insensitive string operators (lowercase suffixes → OrdinalIgnoreCase)
34+
/// Case-insensitive string operators (lowercase suffixes → CurrentCultureIgnoreCase)
3535
module CI =
3636
// String operators (case-insensitive)
3737
[<Literal>]

src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilter.fs

Lines changed: 33 additions & 391 deletions
Large diffs are not rendered by default.

src/FSharp.Data.GraphQL.Server.Middleware/ObjectListFilterModule.fs

Lines changed: 422 additions & 0 deletions
Large diffs are not rendered by default.

src/FSharp.Data.GraphQL.Server.Middleware/SchemaDefinitions.fs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,6 @@ type private ComparisonOperator =
2020
| LessThanOrEqual of string
2121
| In of string
2222

23-
2423
let rec private coerceObjectListFilterInput (variables : Variables) inputValue : Result<ObjectListFilter voption, IGQLError list> =
2524

2625
let parseFieldCondition (s : string) =
Lines changed: 298 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,298 @@
1+
namespace FSharp.Data.GraphQL.Server.Middleware
2+
3+
open System
4+
open System.Collections.Generic
5+
open System.Collections.Immutable
6+
open System.Reflection
7+
open FSharp.Data.GraphQL
8+
open FSharp.Data.GraphQL.Extensions
9+
open FSharp.Reflection
10+
11+
[<RequireQualifiedAccess>]
12+
module TypeCoercion =
13+
14+
/// Case-insensitive instance property lookup. The middleware lowercases field names during
15+
/// parsing, so we must also ignore casing here.
16+
let propertyBindFlags =
17+
BindingFlags.Public
18+
||| BindingFlags.Instance
19+
||| BindingFlags.IgnoreCase
20+
21+
/// DU/union member access flags. Internal cases must be resolvable through reflection.
22+
let unionBindFlags = BindingFlags.Public ||| BindingFlags.NonPublic
23+
24+
// Cached type references
25+
let private stringType = typeof<string>
26+
27+
/// <summary>
28+
/// If <paramref name="t"/> is <c>voption</c>, <c>option</c>, or <c>Skippable</c>, returns the inner type;
29+
/// otherwise <see langword="ValueNone"/>.
30+
/// </summary>
31+
let tryUnwrapOption (t : Type) : Type voption =
32+
if t.IsGenericType then
33+
let fullName = t.GetGenericTypeDefinition().FullName
34+
if
35+
fullName.StartsWith ReflectionHelper.ValueOptionTypeName
36+
|| fullName.StartsWith ReflectionHelper.OptionTypeName
37+
|| fullName.StartsWith ReflectionHelper.SkippableTypeName
38+
then
39+
ValueSome (t.GetGenericArguments().[0])
40+
else
41+
ValueNone
42+
else
43+
ValueNone
44+
45+
let unwrapOption (t : Type) : Type =
46+
tryUnwrapOption t |> ValueOption.defaultValue t
47+
48+
/// <summary>
49+
/// If <paramref name="t"/> is a generic collection, returns the element type. Handles both concrete
50+
/// collections (where <c>IEnumerable</c> is an implemented interface) and properties typed directly as <c>IEnumerable&lt;T&gt;</c>.
51+
/// </summary>
52+
let tryUnwrapEnumerableElement (t : Type) : Type voption =
53+
let isEnumerableInterface (i : Type) =
54+
i.IsGenericType
55+
&& Type.(=) (i.GetGenericTypeDefinition (), typedefof<IEnumerable<_>>)
56+
if Type.(=) (t, stringType) then
57+
ValueNone
58+
elif t.IsArray then
59+
t.GetElementType () |> ValueOption.ofObj
60+
elif isEnumerableInterface t then
61+
ValueSome (t.GetGenericArguments()[0])
62+
else
63+
t.GetInterfaces ()
64+
|> Array.vtryFind isEnumerableInterface
65+
|> ValueOption.map (fun i -> i.GetGenericArguments()[0])
66+
67+
/// <summary>
68+
/// Suffixes the middleware's parser preserves on <c>FieldFilter.FieldName</c> for scalar
69+
/// operators (e.g. <c>meetingId_eq</c>, <c>validFrom_gte</c>). They must be stripped before
70+
/// resolving the actual CLR property.
71+
///
72+
/// These correspond to the lowercase variants produced after Phase 2 parsing in
73+
/// <c>SchemaDefinitions.parseFieldCondition</c>. Longer suffixes are listed first to prevent
74+
/// shorter ones (e.g. <c>_gt</c>) from incorrectly matching longer ones (e.g. <c>_gte</c>).
75+
/// </summary>
76+
let operatorSuffixes =
77+
[|
78+
// String operators (case-insensitive variants)
79+
FilterSuffixConstants.CI.StartsWithSuffix
80+
FilterSuffixConstants.CI.EndsWithSuffix
81+
FilterSuffixConstants.CI.SWSuffix
82+
FilterSuffixConstants.CI.EWSuffix
83+
FilterSuffixConstants.CI.ContainsSuffix
84+
FilterSuffixConstants.CI.EqualsSuffix
85+
FilterSuffixConstants.CI.EQSuffix
86+
// String operators (case-sensitive variants)
87+
FilterSuffixConstants.CS.StartsWithSuffix
88+
FilterSuffixConstants.CS.EndsWithSuffix
89+
FilterSuffixConstants.CS.SWSuffix
90+
FilterSuffixConstants.CS.EWSuffix
91+
FilterSuffixConstants.CS.ContainsSuffix
92+
FilterSuffixConstants.CS.EqualsSuffix
93+
FilterSuffixConstants.CS.EQSuffix
94+
// Numeric/comparison operators (from root)
95+
FilterSuffixConstants.GreaterThanOrEqualSuffix
96+
FilterSuffixConstants.LessThanOrEqualSuffix
97+
FilterSuffixConstants.GreaterThanSuffix
98+
FilterSuffixConstants.LessThanSuffix
99+
FilterSuffixConstants.GTESuffix
100+
FilterSuffixConstants.LTESuffix
101+
FilterSuffixConstants.GTSuffix
102+
FilterSuffixConstants.LTSuffix
103+
FilterSuffixConstants.InSuffix
104+
|]
105+
106+
let stripOperatorSuffix (fieldName : string) : string =
107+
operatorSuffixes
108+
|> Array.vtryFind (fun s -> fieldName.EndsWith (s, StringComparison.OrdinalIgnoreCase))
109+
|> ValueOption.map (fun s -> fieldName.Substring (0, fieldName.Length - s.Length))
110+
|> ValueOption.defaultValue fieldName
111+
112+
// Cached type references for coercion
113+
let private guidType = typeof<Guid>
114+
let private dateTimeOffsetType = typeof<DateTimeOffset>
115+
let private dateTimeType = typeof<DateTime>
116+
let private dateOnlyType = typeof<DateOnly>
117+
let private timeOnlyType = typeof<TimeOnly>
118+
119+
/// <summary>
120+
/// Built-in type coercers for common CLR types. Each coercer takes a boxed value
121+
/// and attempts to parse it (typically from a string) into the target type.
122+
/// </summary>
123+
let private builtInCoercers : ImmutableDictionary<Type, obj -> obj voption> =
124+
let tryParseString (tryParse : string -> bool * 'T) (value : obj) : obj voption =
125+
match value with
126+
| :? string as s ->
127+
match tryParse s with
128+
| true, result -> ValueSome (box result)
129+
| false, _ -> ValueNone
130+
| _ -> ValueNone
131+
132+
seq {
133+
kvp guidType (tryParseString Guid.TryParse)
134+
kvp dateTimeOffsetType (tryParseString DateTimeOffset.TryParse)
135+
kvp dateTimeType (tryParseString DateTime.TryParse)
136+
kvp dateOnlyType (tryParseString DateOnly.TryParse)
137+
kvp timeOnlyType (tryParseString TimeOnly.TryParse)
138+
}
139+
|> ImmutableDictionary.CreateRange
140+
141+
/// <summary>
142+
/// Tries to coerce a JSON-parsed primitive value (typically a <see cref="string"/>) into the
143+
/// CLR <paramref name="targetType"/>. Supports <see cref="Guid"/>, <see cref="DateTime"/>,
144+
/// <see cref="DateTimeOffset"/>, <see cref="DateOnly"/>, <see cref="TimeOnly"/>, and single-case F# DUs around any
145+
/// of the above. Multi-case DUs with fieldless cases are also supported (matches case name
146+
/// case-insensitively).
147+
/// </summary>
148+
// Suppress nullness warnings for the obj / objnull mixture: JSON values can theoretically
149+
// be null but in our middleware path the caller always boxes a non-null primitive.
150+
#nowarn "3261"
151+
let rec tryCoerceValue (customCoercers : FilterValueCoercer list) (targetType : Type) (value : obj | null) : obj voption =
152+
if isNull value then
153+
ValueNone
154+
elif targetType.IsInstanceOfType value then
155+
// Fast path: already the right type.
156+
ValueSome value
157+
else
158+
// Try custom coercers first
159+
let customResult =
160+
customCoercers
161+
|> List.vtryPick (fun coercer -> coercer targetType value)
162+
163+
match customResult with
164+
| ValueSome coerced -> ValueSome coerced
165+
| ValueNone ->
166+
// Try built-in coercers from the static dictionary
167+
match builtInCoercers.TryGetValue targetType with
168+
| true, coercer -> coercer value
169+
| false, _ ->
170+
// F# DU handling
171+
if FSharpType.IsUnion (targetType, unionBindFlags) then
172+
let cases = FSharpType.GetUnionCases (targetType, unionBindFlags)
173+
if cases.Length = 1 then
174+
// Single-case DU wrapping: unwrap one layer and recurse.
175+
let case = cases[0]
176+
let fields = case.GetFields ()
177+
if fields.Length = 1 then
178+
let innerType = fields[0].PropertyType
179+
match tryCoerceValue customCoercers innerType value with
180+
| ValueSome innerVal ->
181+
ValueSome (FSharpValue.MakeUnion (case, [| innerVal |], unionBindFlags))
182+
| ValueNone -> ValueNone
183+
else
184+
ValueNone
185+
else
186+
// Multi-case DU: if the value is a string matching a fieldless case, create that case.
187+
match value with
188+
| :? string as str ->
189+
cases
190+
|> Array.vtryFind (fun c ->
191+
c.GetFields().Length = 0
192+
&& String.Equals (c.Name, str, StringComparison.OrdinalIgnoreCase))
193+
|> ValueOption.map (fun c -> FSharpValue.MakeUnion (c, [||], unionBindFlags))
194+
| _ -> ValueNone
195+
else
196+
ValueNone
197+
198+
/// <summary>
199+
/// Coerces an entire <see cref="ObjectListFilter"/> tree recursively by resolving the
200+
/// entities's properties and converting filter values into the property's CLR type.
201+
/// </summary>
202+
let rec coerceFilter (customCoercers : FilterValueCoercer list) (entityType : Type) (filter : ObjectListFilter) : ObjectListFilter =
203+
match filter with
204+
| And (l, r) -> And (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r)
205+
| Or (l, r) -> Or (coerceFilter customCoercers entityType l, coerceFilter customCoercers entityType r)
206+
| Not f -> Not (coerceFilter customCoercers entityType f)
207+
| OfTypes _ -> filter
208+
| Equals (ff, cmp) ->
209+
match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with
210+
| null -> filter
211+
| prop ->
212+
let unwrapped = unwrapOption prop.PropertyType
213+
match tryCoerceValue customCoercers unwrapped (box ff.Value) with
214+
| ValueNone -> filter
215+
| ValueSome coerced -> Equals ({ ff with Value = coerced :?> IComparable }, cmp)
216+
| GreaterThan ff
217+
| GreaterThanOrEqual ff
218+
| LessThan ff
219+
| LessThanOrEqual ff as originalFilter ->
220+
match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with
221+
| null -> filter
222+
| prop ->
223+
let unwrapped = unwrapOption prop.PropertyType
224+
// For comparison operators, if the property is a single-case DU, coerce to the
225+
// inner type only — not the DU itself. buildFilterExpr handles the cast via
226+
// unsafeConvertTo, and the DU's op_GreaterThan etc. take the inner primitive.
227+
let coercionTarget =
228+
match tryUnwrapOption unwrapped with
229+
| ValueSome inner -> inner // already unwrapped above, shouldn't occur
230+
| ValueNone ->
231+
if FSharpType.IsUnion (unwrapped, unionBindFlags) then
232+
let cases = FSharpType.GetUnionCases (unwrapped, unionBindFlags)
233+
if cases.Length = 1 then
234+
let fields = cases[0].GetFields ()
235+
if fields.Length = 1 then fields[0].PropertyType
236+
else unwrapped
237+
else unwrapped
238+
else unwrapped
239+
match tryCoerceValue customCoercers coercionTarget (box ff.Value) with
240+
| ValueNone -> filter
241+
| ValueSome coerced ->
242+
let coercedField = { ff with Value = coerced :?> IComparable }
243+
match originalFilter with
244+
| GreaterThan _ -> GreaterThan coercedField
245+
| GreaterThanOrEqual _ -> GreaterThanOrEqual coercedField
246+
| LessThan _ -> LessThan coercedField
247+
| LessThanOrEqual _ -> LessThanOrEqual coercedField
248+
| _ -> filter
249+
| In ff ->
250+
match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with
251+
| null -> filter
252+
| prop ->
253+
let unwrapped = unwrapOption prop.PropertyType
254+
let coercedList =
255+
ff.Value
256+
|> List.choose (fun item ->
257+
match tryCoerceValue customCoercers unwrapped item with
258+
| ValueSome coerced -> Some coerced
259+
| ValueNone -> None)
260+
In { ff with Value = coercedList }
261+
| StartsWith (ff, cmp)
262+
| EndsWith (ff, cmp) as originalFilter ->
263+
match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with
264+
| null -> filter
265+
| _ ->
266+
// The pattern argument for string operators is always a plain string —
267+
// never coerce it into the member's DU type.
268+
match tryCoerceValue customCoercers stringType (box ff.Value) with
269+
| ValueNone -> filter
270+
| ValueSome coerced ->
271+
let coercedField = { ff with Value = coerced :?> string }
272+
match originalFilter with
273+
| StartsWith (_, cmp) -> StartsWith (coercedField, cmp)
274+
| EndsWith (_, cmp) -> EndsWith (coercedField, cmp)
275+
| _ -> filter
276+
| Contains (ff, cmp) ->
277+
match entityType.GetProperty (stripOperatorSuffix ff.FieldName, propertyBindFlags) with
278+
| null -> filter
279+
| prop ->
280+
let unwrapped = unwrapOption prop.PropertyType
281+
// For enumerable members coerce to the element type; for string-like members
282+
// keep the pattern value as a plain string (same reasoning as StartsWith/EndsWith).
283+
let coercionTarget =
284+
match tryUnwrapEnumerableElement unwrapped with
285+
| ValueSome elementType -> elementType
286+
| ValueNone -> stringType
287+
match tryCoerceValue customCoercers coercionTarget (box ff.Value) with
288+
| ValueNone -> filter
289+
| ValueSome coerced -> Contains ({ ff with Value = coerced :?> IComparable }, cmp)
290+
| FilterField ff ->
291+
match entityType.GetProperty (ff.FieldName, propertyBindFlags) with
292+
| null -> filter
293+
| prop ->
294+
let unwrapped = unwrapOption prop.PropertyType
295+
let nestedType =
296+
tryUnwrapEnumerableElement unwrapped
297+
|> ValueOption.defaultValue unwrapped
298+
FilterField { FieldName = ff.FieldName; Value = coerceFilter customCoercers nestedType ff.Value }

src/FSharp.Data.GraphQL.Server.Middleware/TypeSystemExtensions.fs

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3,9 +3,7 @@ namespace FSharp.Data.GraphQL.Server.Middleware
33
open System
44
open System.Collections.Immutable
55
open System.Linq
6-
open FsToolkit.ErrorHandling
76

8-
open FSharp.Data.GraphQL
97
open FSharp.Data.GraphQL.Types
108

119
/// Contains extensions for the type system.

0 commit comments

Comments
 (0)