Implemented InputCustom type for internal type definitions

Author: xperiandri

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

@@ -93,7 +93,7 @@ type internal ObjectListFilterMiddleware<'ObjectType, 'ListType>(reportToMetadat
                     |> Seq.map (fun x ->
                         match x.Name, x.Value with
                         | "filter", (VariableName variableName) -> Ok (ValueSome (ctx.Variables[variableName] :?> ObjectListFilter))
-                        | "filter", inlineConstant -> ObjectListFilterType.CoerceInput (InlineConstant inlineConstant) |> Result.map ValueOption.ofObj
+                        | "filter", inlineConstant -> ObjectListFilterType.CoerceInput (InlineConstant inlineConstant) ctx.Variables |> Result.map ValueOption.ofObj
                         | _ -> Ok ValueNone)
                     |> Seq.toList
                 match filterResults |> splitSeqErrorsList with

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

@@ -182,13 +182,14 @@ let rec private jsonElementToInputValue (element : JsonElement) =
     | _ -> raise (NotSupportedException "Unsupported JSON element type")
 
 /// Defines an object list filter for use as an argument for filter list of object fields.
-let ObjectListFilterType : ScalarDefinition<ObjectListFilter> = {
+let ObjectListFilterType : InputCustomDefinition<ObjectListFilter> = {
     Name = "ObjectListFilter"
     Description =
         Some
             "The `Filter` scalar type represents a filter on one or more fields of an object in an object list. The filter is represented by a JSON object where the fields are the complemented by specific suffixes to represent a query."
     CoerceInput =
-        (function
+        (fun input variables ->
+        match input with
         | InlineConstant c ->
             coerceObjectListFilterInput c
             |> Result.map ValueOption.toObj
@@ -197,5 +198,4 @@ let ObjectListFilterType : ScalarDefinition<ObjectListFilter> = {
             |> jsonElementToInputValue
             |> coerceObjectListFilterInput
             |> Result.map ValueOption.toObj)
-    CoerceOutput = coerceObjectListFilterValue
 }

src/FSharp.Data.GraphQL.Server/Execution.fs

@@ -599,7 +599,16 @@ let internal coerceVariables (variables: VarDef list) (vars: ImmutableDictionary
             fun (acc : Result<ImmutableDictionary<string, obj>.Builder, IGQLError list>) struct(varDef, jsonElement) -> validation {
                     let! value =
                         let varTypeDef = varDef.TypeDef
-                        coerceVariableValue false [] ValueNone (varTypeDef, varTypeDef) varDef jsonElement
+                        let ctx = {
+                            IsNullable = false
+                            InputObjectPath = []
+                            ObjectFieldErrorDetails = ValueNone
+                            OriginalTypeDef = varTypeDef
+                            TypeDef = varTypeDef
+                            VarDef = varDef
+                            Input = jsonElement
+                        }
+                        coerceVariableValue ctx
                         |> Result.mapError (
                             List.map (fun err ->
                                 match err with

src/FSharp.Data.GraphQL.Server/Values.fs

@@ -103,6 +103,9 @@ let rec internal compileByType
 
     | Scalar scalardef -> variableOrElse (InlineConstant >> scalardef.CoerceInput)
 
+    | InputCustom customDef ->
+        fun value variables -> customDef.CoerceInput (InlineConstant value) variables
+
     | InputObject objDef ->
         let objtype = objDef.Type
         let ctor = ReflectionHelper.matchConstructor objtype (objDef.Fields |> Array.map (fun x -> x.Name))
@@ -400,15 +403,29 @@ let rec internal compileByType
         Debug.Fail "Unexpected InputDef"
         failwithf "Unexpected value of inputDef: %O" inputDef
 
-let rec internal coerceVariableValue
-    isNullable
-    inputObjectPath
-    (objectFieldErrorDetails : ObjectFieldErrorDetails voption)
-    (originalTypeDef, typeDef)
-    (varDef : VarDef)
-    (input : JsonElement)
+type CoerceVariableContext = {
+    IsNullable : bool
+    InputObjectPath : FieldPath
+    ObjectFieldErrorDetails : ObjectFieldErrorDetails voption
+    OriginalTypeDef : InputDef
+    TypeDef : InputDef
+    VarDef : VarDef
+    Input : JsonElement
+}
+
+let rec internal coerceVariableValue (ctx : CoerceVariableContext)
     : Result<obj, IGQLError list> =
 
+    let {
+        IsNullable = isNullable
+        InputObjectPath = inputObjectPath
+        ObjectFieldErrorDetails = objectFieldErrorDetails
+        OriginalTypeDef = originalTypeDef
+        TypeDef = typeDef
+        VarDef = varDef
+        Input = input
+    } = ctx
+
     let createVariableCoercionError message =
         Error [
             {
@@ -463,12 +480,26 @@ let rec internal coerceVariableValue
         if input.ValueKind = JsonValueKind.Null then
             Ok null
         else
-            coerceVariableValue true inputObjectPath ValueNone (typeDef, innerdef :> InputDef) varDef input
+            let ctx' = {
+                ctx with
+                    IsNullable = true
+                    ObjectFieldErrorDetails = ValueNone
+                    OriginalTypeDef = typeDef
+                    TypeDef = innerdef :> InputDef
+            }
+            coerceVariableValue ctx'
     | Nullable (Input innerdef) ->
         if input.ValueKind = JsonValueKind.Null then
             Ok null
         else
-            coerceVariableValue true inputObjectPath ValueNone (typeDef, innerdef) varDef input
+            let ctx' = {
+                ctx with
+                    IsNullable = true
+                    ObjectFieldErrorDetails = ValueNone
+                    OriginalTypeDef = typeDef
+                    TypeDef = innerdef
+            }
+            coerceVariableValue ctx'
     | List (Input innerDef) ->
         let cons, nil = ReflectionHelper.listOfType innerDef.Type
 
@@ -487,7 +518,15 @@ let rec internal coerceVariableValue
                         let! items =
                             input.EnumerateArray ()
                             |> Seq.mapi (fun i elem ->
-                                coerceVariableValue areItemsNullable ((box i) :: inputObjectPath) ValueNone (originalTypeDef, innerDef) varDef elem)
+                                let ctx' = {
+                                    ctx with
+                                        IsNullable = areItemsNullable
+                                        InputObjectPath = (box i) :: inputObjectPath
+                                        ObjectFieldErrorDetails = ValueNone
+                                        TypeDef = innerDef
+                                        Input = elem
+                                }
+                                coerceVariableValue ctx')
                             |> Seq.toList
                             |> splitSeqErrorsList
                         if areItemsNullable then
@@ -501,7 +540,14 @@ let rec internal coerceVariableValue
                     }
                 else
                     result {
-                        let! single = coerceVariableValue areItemsNullable inputObjectPath ValueNone (innerDef, innerDef) varDef input
+                        let ctx' = {
+                            ctx with
+                                IsNullable = areItemsNullable
+                                ObjectFieldErrorDetails = ValueNone
+                                OriginalTypeDef = innerDef
+                                TypeDef = innerDef
+                        }
+                        let! single = coerceVariableValue ctx'
 
                         if areItemsNullable then
                             let some, none, _ = ReflectionHelper.optionOfType innerDef.Type.GenericTypeArguments[0]
@@ -548,7 +594,16 @@ and private coerceVariableInputObject inputObjectPath (originalObjDef, objDef) (
                         <| { ObjectDef = originalObjDef; FieldDef = ValueSome field }
                     let fieldTypeDef = field.TypeDef
                     let value =
-                        coerceVariableValue false inputObjectPath' objectFieldErrorDetails (fieldTypeDef, fieldTypeDef) varDef value
+                        let ctx = {
+                            IsNullable = false
+                            InputObjectPath = inputObjectPath'
+                            ObjectFieldErrorDetails = objectFieldErrorDetails
+                            OriginalTypeDef = fieldTypeDef
+                            TypeDef = fieldTypeDef
+                            VarDef = varDef
+                            Input = value
+                        }
+                        coerceVariableValue ctx
                     KeyValuePair (field.Name, value)
                 match input.TryGetProperty field.Name with
                 | true, value -> coerce value |> ValueSome

src/FSharp.Data.GraphQL.Shared/TypeSystem.fs

@@ -1757,6 +1757,56 @@ and [<CustomEquality; NoComparison>] InputFieldDefinition<'In> = {
 
     override x.ToString () = x.Name + ": " + x.TypeDef.ToString ()
 
+and internal InputCustomDef =
+    interface
+        /// Name of the input field / argument.
+        abstract Name : string
+        /// Optional input field / argument description.
+        abstract Description : string option
+        /// A function used to retrieve a .NET object from provided GraphQL query or JsonElement variable.
+        abstract CoerceInput : InputParameterValue -> IReadOnlyDictionary<string, obj> -> Result<obj, IGQLError list>
+        inherit TypeDef
+        inherit NamedDef
+        inherit InputDef
+        inherit LeafDef
+    end
+
+and InputCustomDefinition<'Val> = internal {
+    Name : string
+    Description : string option
+    CoerceInput : InputParameterValue -> IReadOnlyDictionary<string, obj> -> Result<'Val, IGQLError list>
+} with
+    interface TypeDef with
+        member _.Type = typeof<'Val>
+
+        member x.MakeNullable () =
+            let nullable : NullableDefinition<_> = { OfType = x }
+            upcast nullable
+
+        member x.MakeList () =
+            let list : ListOfDefinition<_, _> = { OfType = x }
+            upcast list
+
+    interface InputDef
+    interface InputDef<'Val>
+    interface LeafDef
+
+    interface InputCustomDef with
+        member x.Name = x.Name
+        member x.Description = x.Description
+        member x.CoerceInput input variables = x.CoerceInput input variables |> Result.map box
+
+    interface NamedDef with
+        member x.Name = x.Name
+
+    override x.Equals y =
+        match y with
+        | :? InputCustomDefinition<'Val> as f -> x.Name = f.Name
+        | _ -> false
+
+    override x.GetHashCode () = x.Name.GetHashCode ()
+    override x.ToString () = x.Name + "!"
+
 and Tag = System.IComparable
 
 and TagsResolver = ResolveFieldContext -> Tag seq
@@ -2404,6 +2454,12 @@ module Patterns =
         | :? InputObjectDef as x -> ValueSome x
         | _ -> ValueNone
 
+    /// Active pattern to match GraphQL type defintion with input object.
+    let internal (|InputCustom|_|) (tdef : TypeDef) =
+        match tdef with
+        | :? InputCustomDef as x -> ValueSome x
+        | _ -> ValueNone
+
     /// Active patter to match GraphQL subscription object definitions
 
     let (|SubscriptionObject|_|) (tdef : TypeDef) =