Skip to content

Commit

Permalink
Modified ResolverResult<'T> to use voption
Browse files Browse the repository at this point in the history
  • Loading branch information
xperiandri committed Mar 24, 2024
1 parent e8548c2 commit d9746f0
Show file tree
Hide file tree
Showing 4 changed files with 48 additions and 37 deletions.
44 changes: 22 additions & 22 deletions src/FSharp.Data.GraphQL.Server/Execution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -254,13 +254,13 @@ let private resolveField (execute: ExecuteField) (ctx: ResolveFieldContext) (par
|> AsyncVal.map(fun v -> if isNull v then None else Some v)


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

[<RequireQualifiedAccess>]
module ResolverResult =

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

let mapValue (f : 'T -> 'U) (r : ResolverResult<'T>) : ResolverResult<'U> =
Result.map(fun (data, deferred, errs) -> (f data, deferred, errs)) r
Expand Down Expand Up @@ -296,7 +296,7 @@ let deferResults path (res : ResolverResult<obj>) : IObservable<GQLDeferredRespo
| [] -> DeferredResult (data, formattedPath)
| _ -> DeferredErrors (data, errs, formattedPath)
|> Observable.singleton
Option.foldBack Observable.concat deferred deferredData
ValueOption.foldBack Observable.concat deferred deferredData
| Error errs -> Observable.singleton <| DeferredErrors (null, errs, formattedPath)

/// Collect together an array of results using the appropriate execution strategy.
Expand All @@ -312,12 +312,12 @@ let collectFields (strategy : ExecutionStrategy) (rs : AsyncVal<ResolverResult<K
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)
Ok(i - 1, ValueOption.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, []))
Array.foldBack merge collected (Ok (data.Length - 1, ValueNone, []))
|> ResolverResult.mapValue(fun _ -> data)
}

Expand Down Expand Up @@ -363,7 +363,7 @@ let rec private direct (returnDef : OutputDef) (ctx : ResolveFieldContext) (path
| Nullable (Output innerDef) ->
let innerCtx = { ctx with ExecutionInfo = { ctx.ExecutionInfo with IsNullable = true; ReturnDef = innerDef } }
executeResolvers innerCtx path parent (toOption value |> AsyncVal.wrap)
|> AsyncVal.map(Result.valueOr (fun errs -> (KeyValuePair(name, null), None, errs)) >> Ok)
|> AsyncVal.map(Result.valueOr (fun errs -> (KeyValuePair(name, null), ValueNone, errs)) >> Ok)

| Interface iDef ->
let possibleTypesFn = ctx.Schema.GetPossibleTypes
Expand Down Expand Up @@ -398,7 +398,7 @@ and deferred (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (valu
executeResolvers ctx path parent (toOption value |> AsyncVal.wrap)
|> Observable.ofAsyncVal
|> Observable.bind(ResolverResult.mapValue(fun d -> d.Value) >> deferResults path)
ResolverResult.defered (KeyValuePair (info.Identifier, null)) deferred |> AsyncVal.wrap
ResolverResult.defered (KeyValuePair (name, null)) deferred |> AsyncVal.wrap

and private streamed (options : BufferedStreamOptions) (innerDef : OutputDef) (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) =
let info = ctx.ExecutionInfo
Expand All @@ -420,9 +420,9 @@ and private streamed (options : BufferedStreamOptions) (innerDef : OutputDef) (c
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)
(i - 1, box index :: indicies, ValueOption.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, [])
let (_, indicies, deferred, errs) = List.foldBack merge chunk (chunk.Length - 1, [], ValueNone, [])
deferResults (box indicies :: path) (Ok (box data, deferred, errs))

let buffer (items : IObservable<int * ResolverResult<KeyValuePair<string, obj>>>) : IObservable<GQLDeferredResponseContent> =
Expand All @@ -449,8 +449,8 @@ and private streamed (options : BufferedStreamOptions) (innerDef : OutputDef) (c
|> Array.mapi resolveItem
|> Observable.ofAsyncValSeq
|> buffer
ResolverResult.defered (KeyValuePair (info.Identifier, box [])) stream |> AsyncVal.wrap
| _ -> raise <| GQLMessageException (ErrorMessages.expectedEnumerableValue ctx.ExecutionInfo.Identifier (value.GetType()))
ResolverResult.defered (KeyValuePair (name, box [])) stream |> AsyncVal.wrap
| _ -> raise <| GQLMessageException (ErrorMessages.expectedEnumerableValue name (value.GetType()))

and private live (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : obj) =
let info = ctx.ExecutionInfo
Expand Down Expand Up @@ -485,7 +485,7 @@ and private live (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (

executeResolvers 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)))
|> AsyncVal.map(Result.map(fun (data, deferred, errs) -> (data, ValueSome <| ValueOption.foldBack Observable.merge deferred updates, errs)))

/// Actually execute the resolvers.
and private executeResolvers (ctx : ResolveFieldContext) (path : FieldPath) (parent : obj) (value : AsyncVal<obj option>) : AsyncVal<ResolverResult<KeyValuePair<string, obj>>> =
Expand All @@ -505,8 +505,8 @@ and private executeResolvers (ctx : ResolveFieldContext) (path : FieldPath) (par
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
match resolved with
| Error errs when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), None, errs)
| Ok None when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), None, [])
| Error errs when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), ValueNone, errs)
| Ok None when ctx.ExecutionInfo.IsNullable -> return Ok (KeyValuePair(name, null), ValueNone, [])
| Error errs -> return Error errs
| Ok None -> return Error (nullResolverError name path ctx)
| Ok (Some v) -> return! onSuccess ctx path parent v
Expand Down Expand Up @@ -604,16 +604,16 @@ let private executeQueryOrMutation (resultSet: (string * ExecutionInfo) []) (ctx
| Ok (Error errs)
| Error errs -> Error errs
match result with
| Error errs when info.IsNullable -> return Ok (KeyValuePair(name, null), None, errs)
| Error errs when info.IsNullable -> return Ok (KeyValuePair(name, null), ValueNone, 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)
match! resultSet |> Seq.map executeRootOperation |> collectFields ctx.ExecutionPlan.Strategy with
| Ok (data, ValueSome deferred, errs) -> return GQLExecutionResult.Deferred(documentId, NameValueLookup(data), errs, deferred, ctx.Metadata)
| Ok (data, ValueNone, errs) -> return GQLExecutionResult.Direct(documentId, NameValueLookup(data), errs, ctx.Metadata)
| Error errs -> return GQLExecutionResult.RequestError(documentId, errs, ctx.Metadata)
}

Expand All @@ -635,9 +635,9 @@ let private executeSubscription (resultSet: (string * ExecutionInfo) []) (ctx: E
Path = fieldPath |> List.rev }
let onValue v = asyncVal {
match! executeResolvers 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!"
| Ok (data, ValueNone, []) -> return SubscriptionResult (NameValueLookup.ofList [nameOrAlias, data.Value])
| Ok (data, ValueNone, errs) -> return SubscriptionErrors (NameValueLookup.ofList [nameOrAlias, data.Value], errs)
| Ok (_, ValueSome _, _) -> return failwith "Deferred/Streamed/Live are not supported for subscriptions!"
| Error errs -> return SubscriptionErrors (null, errs)
}
return
Expand Down
14 changes: 0 additions & 14 deletions src/FSharp.Data.GraphQL.Shared/Helpers/Extensions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -39,20 +39,6 @@ type TypeInfo with
x.GetDeclaredMethod(first + propertyName.Substring(1))
| prop, _ -> prop

module Option =

let mergeWith (f: 'T -> 'T -> 'T) (o1 : 'T option) (o2 : 'T option) : 'T option =
match (o1, o2) with
| Some a, Some b -> Some (f a b)
| Some a, _ -> Some a
| _, Some b -> Some b
| _, _ -> None

let unwrap (defaultValue : 'U) (onSome : 'T -> 'U) (o : 'T option) : 'U =
match o with
| Some t -> onSome t
| None -> defaultValue

module Skippable =

let ofList list =
Expand Down
24 changes: 24 additions & 0 deletions src/FSharp.Data.GraphQL.Shared/Helpers/ObjAndStructConversions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,18 @@ module internal ValueOption =

let ofOption value = Option.toVOption value

let mergeWith (f: 'T -> 'T -> 'T) (o1 : 'T voption) (o2 : 'T voption) : 'T voption =
match (o1, o2) with
| ValueSome a, ValueSome b -> ValueSome (f a b)
| ValueSome a, _ -> ValueSome a
| _, ValueSome b -> ValueSome b
| _, _ -> ValueNone

let unwrap (defaultValue : 'U) (onSome : 'T -> 'U) (o : 'T voption) : 'U =
match o with
| ValueSome t -> onSome t
| ValueNone -> defaultValue

module internal Option =

let toVOption voption =
Expand All @@ -18,6 +30,18 @@ module internal Option =

let ofVOption voption = voption |> ValueOption.toOption

let mergeWith (f: 'T -> 'T -> 'T) (o1 : 'T option) (o2 : 'T option) : 'T option =
match (o1, o2) with
| Some a, Some b -> Some (f a b)
| Some a, _ -> Some a
| _, Some b -> Some b
| _, _ -> None

let unwrap (defaultValue : 'U) (onSome : 'T -> 'U) (o : 'T option) : 'U =
match o with
| Some t -> onSome t
| None -> defaultValue

[<AutoOpen>]
module internal ValueTuple =

Expand Down
3 changes: 2 additions & 1 deletion src/FSharp.Data.GraphQL.Shared/TypeSystem.fs
Original file line number Diff line number Diff line change
Expand Up @@ -747,7 +747,8 @@ and ExecutionInfoKind =
/// Reduce the current field as a live query.
| ResolveLive of ExecutionInfo

/// Buffered stream options. Used to specify how the buffer will behavior in a stream.
// TODO: Migrate to voption
/// Buffered stream options. Used to specify how the buffer will behave in a stream.
and BufferedStreamOptions =
{ /// The maximum time in milliseconds that the buffer will be filled before being sent to the subscriber.
Interval : int option
Expand Down

0 comments on commit d9746f0

Please sign in to comment.