Execution.fs

// The MIT License (MIT)
// Copyright (c) 2016 Bazinga Technologies Inc
module FSharp.Data.GraphQL.Execution

open System
open System.Collections.Generic
open System.Collections.Immutable
open System.Text.Json
open FSharp.Control.Reactive
open FsToolkit.ErrorHandling

open FSharp.Data.GraphQL.Ast
open FSharp.Data.GraphQL.Errors
open FSharp.Data.GraphQL.Extensions
open FSharp.Data.GraphQL.Helpers
open FSharp.Data.GraphQL.Shared
open FSharp.Data.GraphQL.Types
open FSharp.Data.GraphQL.Types.Patterns
open FSharp.Data.GraphQL

let (|RequestError|Direct|Deferred|Stream|) (response : GQLExecutionResult) =
    match response.Content with
    | RequestError errs -> RequestError errs
    | Direct (data, errors) -> Direct (data, errors)
    | Deferred (data, errors, deferred) -> Deferred (data, errors, deferred)
    | Stream data -> Stream data

let private collectDefaultArgValue acc (argDef: InputFieldDef) =
    match argDef.DefaultValue with
    | Some defVal -> Map.add argDef.Name defVal acc
    | None -> acc

let internal argumentValue inputContext variables (argDef: InputFieldDef) (argument: Argument) =
    match argDef.ExecuteInput inputContext argument.Value variables with
    | Ok null ->
        match argDef.DefaultValue with
        | Some value -> Ok value
        | None -> Ok null
    | result -> result

let private getArgumentValues (argDefs: InputFieldDef []) (args: Argument list) (inputContext : InputExecutionContextProvider) (variables: ImmutableDictionary<string, obj>) : Result<Map<string, obj>, IGQLError list> =
    argDefs
    |> Array.fold (fun acc argdef ->
        match List.tryFind (fun (a: Argument) -> a.Name = argdef.Name) args with
        | Some argument -> validation {
                let! acc = acc
                and! arg = argumentValue inputContext variables argdef argument
                match arg with
                | null -> return acc
                | v -> return Map.add argdef.Name v acc
            }
        | None -> validation {
                let! acc = acc
                return collectDefaultArgValue acc argdef
            }
    ) (Ok Map.empty)

let private getOperation = function
    | OperationDefinition odef -> Some odef
    | _ -> None


/// Search through the Definitions in the given Document for an OperationDefinition with the given name.
/// Or, if there was no name given, and there is only one OperationDefinition in the Document, return that.
let internal findOperation doc opName =
    match doc.Definitions |> List.choose getOperation, opName with
    | [def], _ -> Some def
    | defs, name ->
        defs
        |> List.tryFind (fun def -> def.Name = (name |> ValueOption.ofOption))

let private defaultResolveType possibleTypesFn abstractDef : obj -> ObjectDef =
    let possibleTypes = possibleTypesFn abstractDef
    let mapper = match abstractDef with Union u -> u.ResolveValue | _ -> id
    fun value ->
        let mapped = mapper value
        possibleTypes
        |> Array.find (fun objdef ->
            match objdef.IsTypeOf with
            | Some isTypeOf -> isTypeOf mapped
            | None -> false)

let private resolveInterfaceType possibleTypesFn (interfacedef: InterfaceDef) =
    match interfacedef.ResolveType with
    | Some resolveType -> resolveType
    | None -> defaultResolveType possibleTypesFn interfacedef

let private resolveUnionType possibleTypesFn (uniondef: UnionDef) =
    match uniondef.ResolveType with
    | Some resolveType -> resolveType
    | None -> defaultResolveType possibleTypesFn uniondef

let private createFieldContext objdef inputContext argDefs ctx (info: ExecutionInfo) (path : FieldPath) = result {
    let fdef = info.Definition
    let! args = getArgumentValues argDefs info.Ast.Arguments inputContext ctx.Variables
    return
        { ExecutionInfo = info
          Context = ctx.Context
          ReturnType = fdef.TypeDef
          ParentType = objdef
          Schema = ctx.Schema
          Args = args
          Variables = ctx.Variables
          Path = normalizeErrorPath path }
}

let private resolveField (execute: ExecuteField) (ctx: ResolveFieldContext) (parentValue: obj) =
    if ctx.ExecutionInfo.IsNullable
    then
        execute ctx parentValue
        |> AsyncVal.map(optionCast)
    else
        execute ctx parentValue
        |> AsyncVal.map(fun v -> if isNull v then None else Some v)


type ResolverResult<'T> = Result<'T * IObservable<GQLDeferredResponseContent> option * GQLProblemDetails list, GQLProblemDetails list>

[<RequireQualifiedAccess>]
module ResolverResult =

    let data data  = Ok (data, None, [])
    let defered data deferred = Ok (data, Some deferred, [])

    let mapValue (f : 'T -> 'U) (r : ResolverResult<'T>) : ResolverResult<'U> =
        Result.map(fun (data, deferred, errs) -> (f data, deferred, errs)) r


type StreamOutput =
    | NonList of (KeyValuePair<string, obj> * GQLProblemDetails list)
    | NonBufferedList of int * (KeyValuePair<string, obj> * GQLProblemDetails list)
    | BufferedList of int list * (KeyValuePair<string, obj> * GQLProblemDetails list) list

let private raiseErrors errs = AsyncVal.wrap <| Error errs

/// Given an error e, call ParseError in the given context's Schema to convert it into
/// a list of one or more <see href="IGQLErrors">IGQLErrors</see>, then convert those
/// to a list of <see href="GQLProblemDetails">GQLProblemDetails</see>.
let private resolverError path ctx e = ctx.Schema.ParseError path e |> List.map (GQLProblemDetails.OfFieldExecutionError (normalizeErrorPath path))
// Helper functions for generating more specific <see href="GQLProblemDetails">GQLProblemDetails</see>.
let private nullResolverError name path ctx = resolverError path ctx (GQLMessageException <| sprintf "Non-Null field %s resolved as a null!" name)
let private coercionError value tyName path ctx = resolverError path ctx (GQLMessageException <| sprintf "Value '%O' could not be coerced to scalar %s" value tyName)
let private interfaceImplError ifaceName tyName path ctx = resolverError path ctx (GQLMessageException <| sprintf "GraphQL Interface '%s' is not implemented by the type '%s'" ifaceName tyName)
let private unionImplError unionName tyName path ctx = resolverError path ctx (GQLMessageException (sprintf "GraphQL Union '%s' is not implemented by the type '%s'" unionName tyName))
let private deferredNullableError name tyName path ctx = resolverError path ctx (GQLMessageException (sprintf "Deferred field %s of type '%s' must be nullable" name tyName))
let private streamListError name tyName path ctx = resolverError path ctx (GQLMessageException (sprintf "Streamed field %s of type '%s' must be list" name tyName))

let private resolved name v : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> = KeyValuePair(name, box v) |> ResolverResult.data |> AsyncVal.wrap

let deferResults path (res : ResolverResult<obj>) : IObservable<GQLDeferredResponseContent> =
    let formattedPath = normalizeErrorPath path
    match res with
    | Ok (data, deferred, errs) ->
        let deferredData =
            match errs with
            | [] -> DeferredResult (data, formattedPath)
            | _ -> DeferredErrors (data, errs, formattedPath)
            |> Observable.singleton
        Option.foldBack Observable.concat deferred deferredData
    | Error errs -> Observable.singleton <| DeferredErrors (null, errs, formattedPath)

/// Collect together an array of results using the appropriate execution strategy.
let collectFields (strategy : ExecutionStrategy) (rs : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> []) : AsyncVal<ResolverResult<KeyValuePair<string, obj> []>> = asyncVal {
        let! collected =
            match strategy with
            | Parallel -> AsyncVal.collectParallel rs
            | Sequential -> AsyncVal.collectSequential rs

        let data = Array.zeroCreate (collected.Length)

        let merge r acc =
            match (r, acc) with
            | Ok(field, d, e), Ok(i, deferred, errs) ->
                Array.set data i field
                Ok(i - 1, Option.mergeWith Observable.merge deferred d, e @ errs)
            | Error e, Ok (_, _, errs) -> Error (e @ errs)
            | Ok (_, _, e), Error errs -> Error (e @ errs)
            | Error e, Error errs -> Error (e @ errs)
        return
            Array.foldBack merge collected (Ok (data.Length - 1, None, []))
            |> ResolverResult.mapValue(fun _ -> data)
    }

let rec private direct (returnDef : OutputDef) (inputContext : InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> =
    let name = ctx.ExecutionInfo.Identifier
    match returnDef with

    | Object objDef ->
        let fields =
            match ctx.ExecutionInfo.Kind with
            | SelectFields fields -> fields
            | kind -> failwithf $"Unexpected value of ctx.ExecutionPlan.Kind: %A{kind}"
        executeObjectFields fields name objDef inputContext ctx path value

    | Scalar scalarDef ->
        match scalarDef.CoerceOutput (downcast value) with
        | Some v' -> resolved name v'
        | None -> raiseErrors <| coercionError value scalarDef.Name path ctx

    | Enum enumDef ->
        let enumCase = enumDef.Options |> Array.tryPick(fun case -> if case.Value.Equals(value) then Some case.Name else None)
        match enumCase with
        | Some v' -> resolved name (v' :> obj)
        | None -> raiseErrors <| coercionError value enumDef.Name path  ctx

    | List (Output innerDef) ->
        let innerCtx =
            match ctx.ExecutionInfo.Kind with
            | ResolveCollection innerPlan -> { ctx with ExecutionInfo = { innerPlan with ReturnDef = innerDef } }
            | kind -> failwithf "Unexpected value of ctx.ExecutionPlan.Kind: %A" kind
        let resolveItem index item =
            executeResolvers inputContext innerCtx (box index :: path) value (toOption item |> AsyncVal.wrap)
        match value with
        | :? System.Collections.IEnumerable as enumerable ->
            enumerable
            |> Seq.cast<obj>
            |> Seq.toArray
            |> Array.mapi resolveItem
            |> collectFields Parallel
            |> AsyncVal.map(ResolverResult.mapValue(fun items -> KeyValuePair(name, items |> Array.map(fun d -> d.Value) |> box)))
        | _ -> raise <| GQLMessageException (ErrorMessages.expectedEnumerableValue ctx.ExecutionInfo.Identifier (value.GetType()))

    | Nullable (Output innerDef) ->
        let innerCtx = { ctx with ExecutionInfo = { ctx.ExecutionInfo with IsNullable = true; ReturnDef = innerDef } }
        executeResolvers inputContext innerCtx path parent (toOption value |> AsyncVal.wrap)
        |> AsyncVal.map(Result.valueOr (fun errs -> (KeyValuePair(name, null), None, errs)) >> Ok)

    | Interface iDef ->
        let possibleTypesFn = ctx.Schema.GetPossibleTypes
        let resolver = resolveInterfaceType possibleTypesFn iDef
        let resolvedDef = resolver value
        let typeMap =
            match ctx.ExecutionInfo.Kind with
            | ResolveAbstraction typeMap -> typeMap
            | kind -> failwithf $"Unexpected value of ctx.ExecutionPlan.Kind: %A{kind}"
        match Map.tryFind resolvedDef.Name typeMap with
        | Some fields -> executeObjectFields fields name resolvedDef inputContext ctx path value
        | None -> KeyValuePair(name, obj()) |> ResolverResult.data |> AsyncVal.wrap

    | Union uDef ->
        let possibleTypesFn = ctx.Schema.GetPossibleTypes
        let resolver = resolveUnionType possibleTypesFn uDef
        let resolvedDef = resolver value
        let typeMap =
            match ctx.ExecutionInfo.Kind with
            | ResolveAbstraction typeMap -> typeMap
            | kind -> failwithf $"Unexpected value of ctx.ExecutionPlan.Kind: %A{kind}"
        match Map.tryFind resolvedDef.Name typeMap with
        | Some fields -> executeObjectFields fields name resolvedDef inputContext ctx path (uDef.ResolveValue value)
        | None -> KeyValuePair(name, obj()) |> ResolverResult.data |> AsyncVal.wrap

    | _ -> failwithf "Unexpected value of returnDef: %O" returnDef

and deferred (inputContext : InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) =
    let info = ctx.ExecutionInfo
    let deferred =
        executeResolvers inputContext ctx path parent (toOption value |> AsyncVal.wrap)
        |> Observable.ofAsyncVal
        |> Observable.bind(ResolverResult.mapValue(_.Value) >> deferResults path)
    ResolverResult.defered (KeyValuePair (info.Identifier, null)) deferred |> AsyncVal.wrap

and private streamed (options : BufferedStreamOptions) (innerDef : OutputDef) (inputContext : InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) =
    let info = ctx.ExecutionInfo
    let name = info.Identifier
    let innerCtx =
        match info.Kind with
        | ResolveCollection innerPlan -> { ctx with ExecutionInfo = innerPlan }
        | kind -> failwithf "Unexpected value of ctx.ExecutionPlan.Kind: %A" kind

    let collectBuffered : (int * ResolverResult<KeyValuePair<string, obj>>) list -> IObservable<GQLDeferredResponseContent> = function
        | [] -> Observable.empty
        | [(index, result)] ->
            result
            |> ResolverResult.mapValue(fun d -> box [|d.Value|])
            |> deferResults (box index :: path)
        | chunk ->
            let data = Array.zeroCreate (chunk.Length)
            let merge (index, r : ResolverResult<KeyValuePair<string, obj>>) (i, indicies, deferred, errs) =
                match r with
                | Ok (item, d, e) ->
                    Array.set data i item.Value
                    (i - 1, box index :: indicies, Option.mergeWith Observable.merge deferred d, e @ errs)
                | Error e -> (i - 1, box index :: indicies, deferred, e @ errs)
            let (_, indicies, deferred, errs) = List.foldBack merge chunk (chunk.Length - 1, [], None, [])
            deferResults (box indicies :: path) (Ok (box data, deferred, errs))

    let buffer (items : IObservable<int * ResolverResult<KeyValuePair<string, obj>>>) : IObservable<GQLDeferredResponseContent> =
        let buffered =
            match options.Interval, options.PreferredBatchSize with
            | Some i, None -> Observable.bufferMilliseconds i items |> Observable.map List.ofSeq
            | None, Some c -> Observable.bufferCount c items |> Observable.map List.ofSeq
            | Some i, Some c -> Observable.bufferMillisecondsCount i c items |> Observable.map List.ofSeq
            | None, None -> Observable.map(List.singleton) items
        buffered
        |> Observable.bind collectBuffered

    let resolveItem index item = asyncVal {
        let! result = executeResolvers inputContext innerCtx (box index :: path) parent (toOption item |> AsyncVal.wrap)
        return (index, result)
    }

    match value with
    | :? System.Collections.IEnumerable as enumerable ->
        let stream : IObservable<GQLDeferredResponseContent> =
            enumerable
            |> Seq.cast<obj>
            |> Seq.toArray
            |> Array.mapi resolveItem
            |> Observable.ofAsyncValSeq
            |> buffer
        ResolverResult.defered (KeyValuePair (info.Identifier, box [])) stream |> AsyncVal.wrap
    | _ -> raise <| GQLMessageException (ErrorMessages.expectedEnumerableValue ctx.ExecutionInfo.Identifier (value.GetType()))

and private live (inputContext : InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) =
    let info = ctx.ExecutionInfo
    let name = info.Identifier

    let rec getObjectName = function
        | Object objDef -> objDef.Name
        | Scalar scalarDef -> scalarDef.Name
        | Enum enumDef -> enumDef.Name
        | Nullable (Output innerDef) -> getObjectName innerDef
        | Interface iDef -> iDef.Name
        | Union uDef ->
            let resolver = resolveUnionType ctx.Schema.GetPossibleTypes uDef
            getObjectName (resolver value)
        | returnDef -> failwithf $"Unexpected value of returnDef: {returnDef}"

    let typeName = getObjectName info.ParentDef

    /// So the updatedValue here is actually the fresh parent.
    let resolveUpdate updatedValue =
        executeResolvers inputContext ctx path parent (updatedValue |> Some |> AsyncVal.wrap)
        |> AsyncVal.map(ResolverResult.mapValue(fun d -> d.Value) >> deferResults path)
        |> Observable.ofAsyncVal
        |> Observable.mergeInner

    let provider = ctx.Schema.LiveFieldSubscriptionProvider
    let filter = provider.TryFind typeName name |> Option.map _.Filter
    let updates =
        match filter with
        | Some filterFn -> provider.Add (filterFn parent) typeName name |> Observable.bind resolveUpdate
        | None -> failwithf "No live provider for %s:%s" typeName name

    executeResolvers inputContext ctx path parent (value |> Some |> AsyncVal.wrap)
    // TODO: Add tests for `Observable.merge deferred updates` correct order
    |> AsyncVal.map(Result.map(fun (data, deferred, errs) -> (data, Some <| Option.foldBack Observable.merge deferred updates, errs)))

/// Actually execute the resolvers.
and private executeResolvers (inputContext : InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : AsyncVal<obj option>) : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> =
    let info = ctx.ExecutionInfo
    let name = info.Identifier
    let returnDef = info.ReturnDef

    let rec innerListDef = function
        | Nullable (Output innerDef) -> innerListDef innerDef
        | List (Output innerDef) -> Some innerDef
        | _ -> None

    let (|HasList|_|) = innerListDef

    /// Run a resolution strategy with the provided context.
    /// This handles all null resolver errors/error propagation.
    let resolveWith (ctx : ResolveFieldContext) (onSuccess : ResolveFieldContext -> FieldPath -> obj -> obj -> AsyncVal<ResolverResult<KeyValuePair<string, obj>>>) : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> = asyncVal {
        let! resolved = value |> AsyncVal.rescue path ctx.Schema.ParseError
        let additionalErrs =
            match ctx.Context.Errors.TryGetValue ctx  with
            | true, errors ->
                errors
                |> Seq.map (GQLProblemDetails.OfFieldExecutionError (normalizeErrorPath path))
                |> Seq.toList
            | false, _ -> []
        match resolved with
        | Error errs when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), None, errs @ additionalErrs)
        | Ok None when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), None, additionalErrs)
        | Error errs -> return Error (errs @ additionalErrs)
        | Ok None -> return Error ((nullResolverError name path ctx) @ additionalErrs)
        | Ok (Some v) ->
            match! onSuccess ctx path parent v with
            | Ok (res, deferred, errs) -> return Ok (res, deferred, errs @ additionalErrs)
            | Error errs -> return Error (errs @ additionalErrs)
    }

    match info.Kind, returnDef with
    | ResolveDeferred innerInfo, _ when innerInfo.IsNullable -> // We can only defer nullable fields
        deferred inputContext
        |> resolveWith { ctx with ExecutionInfo = innerInfo }
    | ResolveDeferred innerInfo, _ ->
        raiseErrors <| deferredNullableError (innerInfo.Identifier) (innerInfo.ReturnDef.ToString()) path ctx
    | ResolveStreamed (innerInfo, mode), HasList innerDef -> // We can only stream lists
        streamed mode innerDef inputContext
        |> resolveWith { ctx with ExecutionInfo = innerInfo }
    | ResolveStreamed (innerInfo, _), _ ->
        raiseErrors <| streamListError innerInfo.Identifier (returnDef.ToString()) path ctx
    | ResolveLive innerInfo, _ ->
        live inputContext
        |> resolveWith { ctx with ExecutionInfo = innerInfo }
    | _ ->
        direct returnDef inputContext
        |> resolveWith ctx


and executeObjectFields (fields : ExecutionInfo list) (objName : string) (objDef : ObjectDef) (inputContext: InputExecutionContextProvider) (ctx : ResolveFieldContext) (path : FieldPath) (value : obj) : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> = asyncVal {
    let executeField field =
        let argDefs = ctx.Context.FieldExecuteMap.GetArgs(objDef.Name, field.Definition.Name)
        let resolver = ctx.Context.FieldExecuteMap.GetExecute(objDef.Name, field.Definition.Name)
        let fieldPath = (box field.Identifier :: path)
        match createFieldContext objDef inputContext argDefs ctx field fieldPath with
        | Ok fieldCtx -> executeResolvers inputContext fieldCtx fieldPath value (resolveField resolver fieldCtx value)
        | Error errs -> asyncVal { return Error (errs |> List.map GQLProblemDetails.OfError) }

    let! res =
        fields
        |> Seq.map executeField
        |> Seq.toArray
        |> collectFields Parallel
    match res with
    | Error errs -> return Error errs
    | Ok(kvps, def, errs) -> return Ok (KeyValuePair(objName, box <| NameValueLookup(kvps)), def, errs)
}

let internal compileSubscriptionField (subfield: SubscriptionFieldDef) =
    match subfield.Resolve with
    | Resolve.BoxedFilterExpr(_, _, _, filter) -> fun ctx a b -> filter ctx a b |> AsyncVal.wrap |> AsyncVal.toAsync
    | Resolve.BoxedAsyncFilterExpr(_, _, _, filter) -> filter
    | _ -> raise <| GQLMessageException ("Invalid filter expression for subscription field!")

let internal compileField (fieldDef: FieldDef) : ExecuteField =
    match fieldDef.Resolve with
    | Resolve.BoxedSync(_, _, resolve) ->
        fun resolveFieldCtx value ->
            try resolve resolveFieldCtx value |> AsyncVal.wrap
            with e -> AsyncVal.Failure(e)
    | Resolve.BoxedAsync(_, _, resolve) ->
        fun resolveFieldCtx value -> asyncVal {
                return! resolve resolveFieldCtx value
            }
    | Resolve.BoxedExpr (resolve) ->
        fun resolveFieldCtx value -> downcast resolve resolveFieldCtx value
    | _ ->
        fun _ _ -> raise (InvalidOperationException(sprintf "Field '%s' has been accessed, but no resolve function for that field definition was provided. Make sure, you've specified resolve function or declared field with Define.AutoField method" fieldDef.Name))

let private (|String|Other|) (o : obj) =
    match o with
    | :? string as s -> String s
    | _ -> Other

let private executeQueryOrMutation (resultSet: (string * ExecutionInfo) []) (ctx: ExecutionContext) (objDef: ObjectDef) (rootValue : obj) : AsyncVal<GQLExecutionResult> =
    let executeRootOperation (name, info) =
        let fDef = info.Definition
        let argDefs = ctx.FieldExecuteMap.GetArgs(ctx.ExecutionPlan.RootDef.Name, info.Definition.Name)
        match getArgumentValues argDefs info.Ast.Arguments ctx.GetInputContext ctx.Variables with
        | Error errs -> asyncVal { return Error (errs |> List.map GQLProblemDetails.OfError) }
        | Ok args ->
            let path = [ box info.Identifier ]
            let fieldCtx =
                { ExecutionInfo = info
                  Context = ctx
                  ReturnType = fDef.TypeDef
                  ParentType = objDef
                  Schema = ctx.Schema
                  Args = args
                  Variables = ctx.Variables
                  Path = normalizeErrorPath path }
            let execute = ctx.FieldExecuteMap.GetExecute(ctx.ExecutionPlan.RootDef.Name, info.Definition.Name)
            asyncVal {
                let! result =
                    executeResolvers ctx.GetInputContext fieldCtx path rootValue (resolveField execute fieldCtx rootValue)
                    |> AsyncVal.rescue path ctx.Schema.ParseError
                let result =
                    match result with
                    | Ok (Ok value) -> Ok value
                    | Ok (Error errs)
                    | Error errs -> Error errs
                match result with
                | Error errs when info.IsNullable -> return Ok (KeyValuePair(name, null), None, errs)
                | Error errs -> return Error errs
                | Ok r -> return Ok r
            }

    asyncVal {
        let documentId = ctx.ExecutionPlan.DocumentId
        match! resultSet |> Array.map executeRootOperation |> collectFields ctx.ExecutionPlan.Strategy with
        | Ok (data, Some deferred, errs) -> return GQLExecutionResult.Deferred(documentId, NameValueLookup(data), errs, deferred, ctx.Metadata)
        | Ok (data, None, errs) -> return GQLExecutionResult.Direct(documentId, NameValueLookup(data), errs, ctx.Metadata)
        | Error errs -> return GQLExecutionResult.RequestError(documentId, errs, ctx.Metadata)
    }

let private executeSubscription (resultSet: (string * ExecutionInfo) []) (inputContext : InputExecutionContextProvider) (ctx: ExecutionContext) (objDef: SubscriptionObjectDef) value = result {
    // Subscription queries can only have one root field
    let nameOrAlias, info = Array.head resultSet
    let subDef = info.Definition :?> SubscriptionFieldDef
    let! args = getArgumentValues subDef.Args info.Ast.Arguments inputContext ctx.Variables
    let returnType = subDef.OutputTypeDef
    let fieldPath = [ box info.Identifier ]
    let fieldCtx =
        { ExecutionInfo = info
          Context = ctx
          ReturnType = returnType
          ParentType = objDef
          Schema = ctx.Schema
          Args = args
          Variables = ctx.Variables
          Path = fieldPath |> List.rev }
    let onValue v = asyncVal {
            match! executeResolvers inputContext fieldCtx fieldPath value (toOption v |> AsyncVal.wrap) with
            | Ok (data, None, []) -> return SubscriptionResult (NameValueLookup.ofList [nameOrAlias, data.Value])
            | Ok (data, None, errs) -> return SubscriptionErrors (NameValueLookup.ofList [nameOrAlias, data.Value], errs)
            | Ok (_, Some _, _) -> return failwith "Deferred/Streamed/Live are not supported for subscriptions!"
            | Error errs -> return SubscriptionErrors (null, errs)
        }
    return
        ctx.Schema.SubscriptionProvider.Add fieldCtx value subDef
        |> Observable.bind(onValue >> Observable.ofAsyncVal)
}

let private compileInputObject (inputDef: InputObjectDef) (inputContext : InputExecutionContextProvider) =
    inputDef.Fields
    |> Array.iter(fun inputField ->
        // TODO: Implement compilation cache to reuse for the same type
        let inputFieldTypeDef = inputField.TypeDef
        inputField.ExecuteInput <- compileByType [ box inputField.Name ] Unknown (inputFieldTypeDef, inputFieldTypeDef) inputContext
        match inputField.TypeDef with
        | InputObject inputObjDef -> inputObjDef.ExecuteInput <- inputField.ExecuteInput
        | _ -> ()
    )
#if DEBUG
    if isNull (box inputDef.ExecuteInput) then
        System.Diagnostics.Debug.Fail($"Input object '{inputDef.Name}' has no ExecuteInput function!")
#endif

let private compileObject (objDef: ObjectDef) (executeFields: FieldDef -> unit) (inputContext : InputExecutionContextProvider) =
    objDef.Fields
    |> Map.iter (fun _ fieldDef ->
        executeFields fieldDef
        fieldDef.Args
        |> Array.iter (fun arg ->
            //let errMsg = $"Object '%s{objdef.Name}': field '%s{fieldDef.Name}': argument '%s{arg.Name}': "
            // TODO: Pass arg name
            let argTypeDef = arg.TypeDef
            arg.ExecuteInput <- compileByType [] (Argument arg) (argTypeDef, argTypeDef) inputContext
            match arg.TypeDef with
            | InputObject inputObjDef -> inputObjDef.ExecuteInput <- arg.ExecuteInput
            | _ -> ()
        )
    )

let internal compileSchema (ctx : SchemaCompileContext)  =
    ctx.Schema.TypeMap.ToSeq()
    |> Seq.iter (fun (tName, x) ->
        match x with
        | SubscriptionObject subDef ->
            compileObject subDef (fun sub ->
                let filter =
                    match sub with
                    | :? SubscriptionFieldDef as subField -> compileSubscriptionField subField
                    | _ -> failwith $"Schema error: subscription object '%s{subDef.Name}' does have a field '%s{sub.Name}' that is not a subscription field definition."
                ctx.Schema.SubscriptionProvider.Register { Name = sub.Name; Filter = filter }) ctx.GetInputContext
        | Object objDef ->
            compileObject objDef (fun fieldDef -> ctx.FieldExecuteMap.SetExecute(tName, fieldDef)) ctx.GetInputContext
        | InputObject inputDef -> compileInputObject inputDef ctx.GetInputContext
        | _ -> ())

let internal coerceVariables (variables: VarDef list) (inputContext : InputExecutionContextProvider) (vars: ImmutableDictionary<string, JsonElement>) = result {
    let variables, inlineValues, nulls =
        variables
        |> List.fold
            (fun (valiables, inlineValues, missing) varDef ->
                match vars.TryGetValue varDef.Name with
                | false, _ ->
                    match varDef.DefaultValue with
                    | Some defaultValue ->
                        let item = struct(varDef, defaultValue)
                        (valiables, item::inlineValues, missing)
                    | None ->
                        let item =
                            match varDef.TypeDef with
                            | Nullable _ -> Ok <| KeyValuePair(varDef.Name, null)
                            | Named typeDef -> Error [ {
                                    Message = $"A variable '$%s{varDef.Name}' of type '%s{typeDef.Name}!' is not nullable but neither value was provided, nor a default value was specified."
                                    ErrorKind = InputCoercion
                                    InputSource = Variable varDef
                                    Path = []
                                    FieldErrorDetails = ValueNone
                                } :> IGQLError ]
                            | _ -> System.Diagnostics.Debug.Fail $"{varDef.TypeDef.GetType().Name} is not Named"; failwith "Impossible case"
                        (valiables, inlineValues, item::missing)
                | true, jsonElement ->
                    let item = struct(varDef, jsonElement)
                    (item::valiables, inlineValues, missing)
                )
            ([], [], [])

    // First we need to coerce variables
    let! variablesBuilder =
        variables
        |> List.fold (
            fun (acc : Result<ImmutableDictionary<string, obj>.Builder, IGQLError list>) struct(varDef, jsonElement) -> validation {
                    let! value =
                        let varTypeDef = varDef.TypeDef
                        let ctx = {
                            IsNullable = false
                            InputObjectPath = []
                            ObjectFieldErrorDetails = ValueNone
                            OriginalTypeDef = varTypeDef
                            TypeDef = varTypeDef
                            VarDef = varDef
                            Input = jsonElement
                        }
                        coerceVariableValue(ctx, inputContext)
                        |> Result.mapError (
                            List.map (fun err ->
                                match err with
                                | :? IInputSourceError as err ->
                                    match err.InputSource with
                                    | Variable _ -> ()
                                    | _ -> err.InputSource <- Variable varDef
                                | _ -> ()
                                err)
                        )
                    and! acc = acc
                    acc.Add(varDef.Name, value)
                    return acc
                })
                (ImmutableDictionary.CreateBuilder<string, obj>() |> Ok)

    let suppliedVariables = variablesBuilder.ToImmutable()

    // TODO: consider how to execute inline objects validation having some variables coercion or validation failed
    // Having variables we can coerce inline values that contain on variables
    let! variablesBuilder =
        inlineValues
        |> List.fold (
            fun (acc : Result<ImmutableDictionary<string, obj>.Builder, IGQLError list>) struct(varDef, defaultValue) -> validation {
                    let varTypeDef = varDef.TypeDef
                    let executeInput = compileByType [] (Variable varDef) (varTypeDef, varTypeDef) inputContext
                    let! value = executeInput inputContext defaultValue suppliedVariables
                    and! acc = acc
                    acc.Add (varDef.Name, value)
                    return acc
                })
                (variablesBuilder |> Ok)

    and! nulls = nulls |> splitSeqErrorsList

    nulls |> Array.iter variablesBuilder.Add

    return variablesBuilder.ToImmutable()
}

#nowarn "0046"

let internal executeOperation (ctx : ExecutionContext) : AsyncVal<GQLExecutionResult> =
    let includeResults =
        ctx.ExecutionPlan.Fields
        |> List.map (
            fun info ->
                info.Include ctx.Variables
                |> Result.map (fun include -> struct(info, include))
            )
    match includeResults |> splitSeqErrorsList with
    | Error errs -> asyncVal { return GQLExecutionResult.Error(ctx.ExecutionPlan.DocumentId, errs, ctx.Metadata) }
    | Ok includes ->

    let resultSet =
        includes
        |> Seq.filter sndv
        |> Seq.map fstv
        |> Seq.map (fun info -> (info.Identifier, info))
        |> Seq.toArray
    match ctx.ExecutionPlan.Operation.OperationType with
    | Query -> executeQueryOrMutation resultSet ctx ctx.Schema.Query ctx.RootValue
    | Mutation ->
        match ctx.Schema.Mutation with
        | Some m -> executeQueryOrMutation resultSet ctx m ctx.RootValue
        | None -> raise(InvalidOperationException("Attempted to make a mutation but no mutation schema was present!"))
    | Subscription ->
        match ctx.Schema.Subscription with
        | Some s ->
            match executeSubscription resultSet ctx.GetInputContext ctx s ctx.RootValue with
            | Ok data -> AsyncVal.wrap(GQLExecutionResult.Stream(ctx.ExecutionPlan.DocumentId, data, ctx.Metadata))
            | Error errs -> asyncVal { return GQLExecutionResult.Error(ctx.ExecutionPlan.DocumentId, errs, ctx.Metadata) }

        | None -> raise(InvalidOperationException("Attempted to make a subscription but no subscription schema was present!"))