@@ -37,7 +37,7 @@ let private normalizeOptional (outputType : Type) value =
37
37
let inputType = value.GetType ()
38
38
if inputType.Name <> outputType.Name then
39
39
// Use only when option or voption so must not be null
40
- let expectedOutputType = outputType.GenericTypeArguments.FirstOrDefault()
40
+ let expectedOutputType = outputType.GenericTypeArguments.FirstOrDefault ()
41
41
if
42
42
outputType.FullName.StartsWith ReflectionHelper.OptionTypeName
43
43
&& expectedOutputType.IsAssignableFrom inputType
@@ -52,7 +52,7 @@ let private normalizeOptional (outputType : Type) value =
52
52
valuesome value
53
53
else
54
54
// Use only when option or voption so must not be null
55
- let actualInputType = inputType.GenericTypeArguments.FirstOrDefault()
55
+ let actualInputType = inputType.GenericTypeArguments.FirstOrDefault ()
56
56
if
57
57
inputType.FullName.StartsWith ReflectionHelper.OptionTypeName
58
58
&& outputType.IsAssignableFrom actualInputType
@@ -109,63 +109,66 @@ let rec internal compileByType
109
109
let objtype = objDef.Type
110
110
let ctor = ReflectionHelper.matchConstructor objtype ( objDef.Fields |> Array.map ( fun x -> x.Name))
111
111
112
- let struct ( mapper , typeMismatchParameters , nullableMismatchParameters , missingParameters ) =
113
- ctor.GetParameters ()
114
- |> Array.fold
115
- ( fun struct (
116
- all : ResizeArray < _ >,
117
- mismatch : HashSet < _ >,
118
- areNullable : HashSet < _ >,
119
- missing : HashSet < _ >
120
- )
121
- param
122
- ->
123
- match
124
- objDef.Fields
125
- |> Array.tryFind ( fun field -> field.Name = param.Name)
126
- with
127
- | Some field ->
128
- match field.TypeDef with
129
- | Nullable _ when
130
- ReflectionHelper.isPrameterMandatory param
131
- && field.DefaultValue.IsNone
132
- ->
133
- areNullable.Add param.Name |> ignore
134
- | inputDef ->
135
- if ReflectionHelper.isAssignableWithUnwrap inputDef.Type param.ParameterType then
136
- all.Add ( struct ( ValueSome field, param)) |> ignore
112
+ let parametersMap =
113
+ let typeMismatchParameters = HashSet ()
114
+ let nullableMismatchParameters = HashSet ()
115
+ let missingParameters = HashSet ()
116
+
117
+ let allParameters =
118
+ ctor.GetParameters ()
119
+ |> Array.fold
120
+ ( fun ( allParameters : _ ResizeArray ) param ->
121
+ match
122
+ objDef.Fields
123
+ |> Array.tryFind ( fun field -> field.Name = param.Name)
124
+ with
125
+ | Some field ->
126
+ match field.TypeDef with
127
+ | Nullable _ when
128
+ ReflectionHelper.isPrameterMandatory param
129
+ && field.DefaultValue.IsNone
130
+ ->
131
+ nullableMismatchParameters.Add param.Name |> ignore
132
+ | inputDef ->
133
+ let inputType , paramType = inputDef.Type, param.ParameterType
134
+ if ReflectionHelper.isAssignableWithUnwrap inputType paramType then
135
+ allParameters.Add ( struct ( ValueSome field, param))
136
+ |> ignore
137
+ else
138
+ // TODO: Consider improving by specifying type mismatches
139
+ typeMismatchParameters.Add param.Name |> ignore
140
+ | None ->
141
+ if ReflectionHelper.isParameterOptional param then
142
+ allParameters.Add <| struct ( ValueNone, param) |> ignore
137
143
else
138
- // TODO: Consider improving by specifying type mismatches
139
- mismatch.Add param.Name |> ignore
140
- | None ->
141
- if ReflectionHelper.isParameterOptional param then
142
- all.Add <| struct ( ValueNone, param) |> ignore
143
- else
144
- missing.Add param.Name |> ignore
145
- struct ( all, mismatch, areNullable, missing))
146
- struct ( ResizeArray (), HashSet (), HashSet (), HashSet ())
147
-
148
- let exceptions : exn list = [
149
- if missingParameters.Any () then
150
- let message =
151
- let ``params`` = String.Join ( " ', '" , missingParameters)
152
- $" Input object '%s {objDef.Name}' refers to type '%O {objtype}', but mandatory constructor parameters '%s {``params``}' don't match any of the defined GraphQL input fields"
153
- InvalidInputTypeException ( message, missingParameters.ToImmutableHashSet ())
154
- if nullableMismatchParameters.Any () then
155
- let message =
156
- let ``params`` = String.Join ( " ', '" , nullableMismatchParameters)
157
- $" Input object %s {objDef.Name} refers to type '%O {objtype}', but constructor parameters for optional GraphQL fields '%s {``params``}' are not optional"
158
- InvalidInputTypeException ( message, nullableMismatchParameters.ToImmutableHashSet ())
159
- if typeMismatchParameters.Any () then
160
- let message =
161
- let ``params`` = String.Join ( " ', '" , typeMismatchParameters)
162
- $" Input object %s {objDef.Name} refers to type '%O {objtype}', but GraphQL fields '%s {``params``}' have different types than constructor parameters"
163
- InvalidInputTypeException ( message, typeMismatchParameters.ToImmutableHashSet ())
164
- ]
165
- match exceptions with
166
- | [] -> ()
167
- | [ ex ] -> raise ex
168
- | _ -> raise ( AggregateException ( $" Invalid input object '%O {objtype}'" , exceptions))
144
+ missingParameters.Add param.Name |> ignore
145
+ allParameters)
146
+ ( ResizeArray ())
147
+ |> ImmutableArray.CreateRange
148
+
149
+ let exceptions : exn list = [
150
+ if missingParameters.Any () then
151
+ let message =
152
+ let ``params`` = String.Join ( " ', '" , missingParameters)
153
+ $" Input object '%s {objDef.Name}' refers to type '%O {objtype}', but mandatory constructor parameters '%s {``params``}' don't match any of the defined GraphQL input fields"
154
+ InvalidInputTypeException ( message, missingParameters.ToImmutableHashSet ())
155
+ if nullableMismatchParameters.Any () then
156
+ let message =
157
+ let ``params`` = String.Join ( " ', '" , nullableMismatchParameters)
158
+ $" Input object %s {objDef.Name} refers to type '%O {objtype}', but constructor parameters for optional GraphQL fields '%s {``params``}' are not optional"
159
+ InvalidInputTypeException ( message, nullableMismatchParameters.ToImmutableHashSet ())
160
+ if typeMismatchParameters.Any () then
161
+ let message =
162
+ let ``params`` = String.Join ( " ', '" , typeMismatchParameters)
163
+ $" Input object %s {objDef.Name} refers to type '%O {objtype}', but GraphQL fields '%s {``params``}' have different types than constructor parameters"
164
+ InvalidInputTypeException ( message, typeMismatchParameters.ToImmutableHashSet ())
165
+ ]
166
+ match exceptions with
167
+ | [] -> ()
168
+ | [ ex ] -> raise ex
169
+ | _ -> raise ( AggregateException ( $" Invalid input object '%O {objtype}'" , exceptions))
170
+
171
+ allParameters
169
172
170
173
let attachErrorExtensionsIfScalar inputSource path objDef ( fieldDef : InputFieldDef ) result =
171
174
@@ -192,10 +195,13 @@ let rec internal compileByType
192
195
}
193
196
194
197
fun value variables ->
198
+ #if DEBUG
199
+ let objDef = objDef
200
+ #endif
195
201
match value with
196
202
| ObjectValue props -> result {
197
203
let argResults =
198
- mapper
204
+ parametersMap
199
205
|> Seq.map ( fun struct ( field , param ) ->
200
206
match field with
201
207
| ValueSome field ->
@@ -227,7 +233,7 @@ let rec internal compileByType
227
233
| : ? IReadOnlyDictionary < string , obj > as objectFields ->
228
234
229
235
let argResults =
230
- mapper
236
+ parametersMap
231
237
|> Seq.map ( fun struct ( field , param ) -> result {
232
238
match field with
233
239
| ValueSome field ->
@@ -313,6 +319,9 @@ let rec internal compileByType
313
319
| InputObject inputObjDef -> inputObjDef.ExecuteInput <- inner
314
320
| _ -> ()
315
321
fun value variables ->
322
+ #if DEBUG
323
+ let innerDef = innerDef
324
+ #endif
316
325
match value with
317
326
| NullValue -> Ok null
318
327
| _ -> inner value variables
@@ -485,7 +494,7 @@ and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (
485
494
| JsonValueKind.Object -> result {
486
495
let mappedResult =
487
496
objDef.Fields
488
- |> Array.map ( fun field ->
497
+ |> Seq.vchoose ( fun field ->
489
498
let inline coerce value =
490
499
let inputObjectPath ' = ( box field.Name) :: inputObjectPath
491
500
let objectFieldErrorDetails =
@@ -496,11 +505,12 @@ and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (
496
505
coerceVariableValue false inputObjectPath' objectFieldErrorDetails ( fieldTypeDef, fieldTypeDef) varDef value
497
506
KeyValuePair ( field.Name, value)
498
507
match input.TryGetProperty field.Name with
499
- | true , value -> coerce value
508
+ | true , value -> coerce value |> ValueSome
500
509
| false , _ ->
501
510
match field.DefaultValue with
502
511
| Some value -> KeyValuePair ( field.Name, Ok value)
503
- | None -> coerce ( JsonDocument.Parse( " null" ) .RootElement))
512
+ | None -> coerce ( JsonDocument.Parse( " null" ) .RootElement)
513
+ |> ValueSome)
504
514
|> ImmutableDictionary.CreateRange
505
515
506
516
let! mapped = mappedResult |> splitObjectErrorsList
0 commit comments