Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Union and interface support #70

Merged
merged 2 commits into from
Jul 20, 2018
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
32 changes: 16 additions & 16 deletions .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -8,19 +8,19 @@ env:
global:
- PINS="graphql_parser:. graphql:. graphql-async:. graphql-lwt:."
matrix:
- PACKAGE="graphql_parser" DISTRO="ubuntu-16.04" OCAML_VERSION="4.03.0"
- PACKAGE="graphql_parser" DISTRO="alpine-3.5" OCAML_VERSION="4.04.2"
- PACKAGE="graphql_parser" DISTRO="debian-unstable" OCAML_VERSION="4.05.0"
- PACKAGE="graphql_parser" DISTRO="debian-testing" OCAML_VERSION="4.06.0"
- PACKAGE="graphql" DISTRO="alpine-3.5" OCAML_VERSION="4.03.0"
- PACKAGE="graphql" DISTRO="debian-unstable" OCAML_VERSION="4.04.2"
- PACKAGE="graphql" DISTRO="debian-testing" OCAML_VERSION="4.05.0"
- PACKAGE="graphql" DISTRO="ubuntu-16.04" OCAML_VERSION="4.06.0"
- PACKAGE="graphql-lwt" DISTRO="debian-unstable" OCAML_VERSION="4.03.0"
- PACKAGE="graphql-lwt" DISTRO="debian-testing" OCAML_VERSION="4.04.2"
- PACKAGE="graphql-lwt" DISTRO="ubuntu-16.04" OCAML_VERSION="4.05.0"
- PACKAGE="graphql-lwt" DISTRO="alpine-3.5" OCAML_VERSION="4.06.0"
- PACKAGE="graphql-async" DISTRO="debian-testing" OCAML_VERSION="4.03.0"
- PACKAGE="graphql-async" DISTRO="ubuntu-16.04" OCAML_VERSION="4.04.2"
- PACKAGE="graphql-async" DISTRO="alpine-3.5" OCAML_VERSION="4.05.0"
- PACKAGE="graphql-async" DISTRO="debian-unstable" OCAML_VERSION="4.06.0"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.03.0" PACKAGE="graphql_parser"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.04.2" PACKAGE="graphql_parser"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.05.0" PACKAGE="graphql_parser"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.06.0" PACKAGE="graphql_parser"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.03.0" PACKAGE="graphql"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.04.2" PACKAGE="graphql"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.05.0" PACKAGE="graphql"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.06.0" PACKAGE="graphql"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.03.0" PACKAGE="graphql-lwt"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.04.2" PACKAGE="graphql-lwt"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.05.0" PACKAGE="graphql-lwt"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.06.0" PACKAGE="graphql-lwt"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.03.0" PACKAGE="graphql-async"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.04.2" PACKAGE="graphql-async"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.05.0" PACKAGE="graphql-async"
- DISTRO="ubuntu-16.04" OCAML_VERSION="4.06.0" PACKAGE="graphql-async"
24 changes: 24 additions & 0 deletions graphql/src/graphql_intf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -110,6 +110,30 @@ module type Schema = sig

val non_null : ('ctx, 'src option) typ -> ('ctx, 'src) typ

type ('ctx, 'a) abstract_value
type ('ctx, 'a) abstract_typ = ('ctx, ('ctx, 'a) abstract_value option) typ

val union : ?doc:string ->
string ->
('ctx, 'a) abstract_typ

type abstract_field
val abstract_field : ?doc:string ->
?deprecated:deprecated ->
string ->
typ:(_, 'a) typ ->
args:('a, _) Arg.arg_list ->
abstract_field

val interface : ?doc:string ->
string ->
fields:(('ctx, 'a) abstract_typ -> abstract_field list) ->
('ctx, 'a) abstract_typ

val add_type : ('ctx, 'a) abstract_typ ->
('ctx, 'src option) typ ->
'src -> ('ctx, 'a) abstract_value

(** {3 Built-in scalars} *)

val int : ('ctx, int option) typ
Expand Down
98 changes: 84 additions & 14 deletions graphql/src/graphql_schema.ml
Original file line number Diff line number Diff line change
Expand Up @@ -296,6 +296,7 @@ module Make(Io : IO) = struct
name : string;
doc : string option;
fields : ('ctx, 'src) field list Lazy.t;
abstracts : abstract list ref;
}
and (_, _) field =
Field : {
Expand All @@ -313,6 +314,22 @@ module Make(Io : IO) = struct
| NonNullable : ('ctx, 'src option) typ -> ('ctx, 'src) typ
| Scalar : 'src scalar -> ('ctx, 'src option) typ
| Enum : 'src enum -> ('ctx, 'src option) typ
| Abstract : abstract -> ('ctx, ('ctx, 'a) abstract_value option) typ
and any_typ =
| AnyTyp : (_, _) typ -> any_typ
| AnyArgTyp : _ Arg.arg_typ -> any_typ
and abstract = {
name : string;
doc : string option;
kind : [`Union | `Interface of abstract_field list Lazy.t];
mutable types : any_typ list;
}
and abstract_field =
AbstractField : (_, _) field -> abstract_field
and ('ctx, 'a) abstract_value =
AbstractValue : ('ctx, 'src option) typ * 'src -> ('ctx, 'a) abstract_value

type ('ctx, 'a) abstract_typ = ('ctx, ('ctx, 'a) abstract_value option) typ

type 'ctx schema = {
query : ('ctx, unit) obj;
Expand All @@ -323,20 +340,22 @@ module Make(Io : IO) = struct
query = {
name = query_name;
doc = None;
abstracts = ref [];
fields = lazy fields;
};
mutation = Option.map mutations ~f:(fun fields ->
{
name = mutation_name;
doc = None;
abstracts = ref [];
fields = lazy fields;
}
)
}

(* Constructor functions *)
let obj ?doc name ~fields =
let rec o = Object { name; doc; fields = lazy (fields o)} in
let rec o = Object { name; doc; fields = lazy (fields o); abstracts = ref []} in
o

let field ?doc ?(deprecated=NotDeprecated) name ~typ ~args ~resolve =
Expand All @@ -345,6 +364,9 @@ module Make(Io : IO) = struct
let io_field ?doc ?(deprecated=NotDeprecated) name ~typ ~args ~resolve =
Field { name; doc; deprecated; typ; args; resolve; lift = id }

let abstract_field ?doc ?(deprecated=NotDeprecated) name ~typ ~args =
AbstractField (Field { lift = Io.ok; name; doc; deprecated; typ; args; resolve = Obj.magic () })

let enum ?doc name ~values =
Enum { name; doc; values }

Expand All @@ -357,6 +379,23 @@ module Make(Io : IO) = struct
let non_null typ =
NonNullable typ

let union ?doc name =
Abstract { name; doc; types = []; kind = `Union }

let interface ?doc name ~fields =
let rec i = Abstract { name; doc; types = []; kind = `Interface (lazy (fields i)) } in
i

let add_type abstract_typ typ =
match (abstract_typ, typ) with
| Abstract a, Object o ->
(* TODO add subtype check here *)
a.types <- (AnyTyp typ)::a.types;
o.abstracts := a :: !(o.abstracts);
fun src -> AbstractValue (typ, src)
| _ ->
invalid_arg "Arguments must be Interface/Union and Object"

(* Built-in scalars *)
let int : 'ctx. ('ctx, int option) typ = Scalar {
name = "Int";
Expand Down Expand Up @@ -390,9 +429,6 @@ module Make(Io : IO) = struct

module Introspection = struct
(* any_typ, any_field and any_arg hide type parameters to avoid scope escaping errors *)
type any_typ =
| AnyTyp : (_, _) typ -> any_typ
| AnyArgTyp : _ Arg.arg_typ -> any_typ
type any_field =
| AnyField : (_, _) field -> any_field
| AnyArgField : _ Arg.arg -> any_field
Expand All @@ -406,7 +442,7 @@ module Introspection = struct
f (result, visited)

(* Extracts all types contained in a single type *)
let rec types : type src. ?memo:(any_typ list * StringSet.t) -> ('ctx, src) typ -> (any_typ list * StringSet.t) = fun ?(memo=([], StringSet.empty)) typ ->
let rec types : type ctx src. ?memo:(any_typ list * StringSet.t) -> (ctx, src) typ -> (any_typ list * StringSet.t) = fun ?(memo=([], StringSet.empty)) typ ->
match typ with
| List typ -> types ~memo typ
| NonNullable typ -> types ~memo typ
Expand All @@ -428,6 +464,13 @@ module Introspection = struct
in
List.fold_left reducer (result', visited') (Lazy.force o.fields)
)
| Abstract a as abstract ->
unless_visited memo a.name (fun (result, visited) ->
let result' = (AnyTyp abstract)::result in
let visited' = StringSet.add a.name visited in
List.fold_left (fun memo (AnyTyp typ) -> types ~memo typ) (result', visited') a.types
)

and arg_types : type a. (any_typ list * StringSet.t) -> a Arg.arg_typ -> (any_typ list * StringSet.t) = fun memo argtyp ->
match argtyp with
| Arg.List typ -> arg_types memo typ
Expand Down Expand Up @@ -464,6 +507,8 @@ module Introspection = struct
let memo' = List.cons (AnyArg arg) memo in
args_to_list ~memo:memo' args

let no_abstracts = ref []

let __type_kind = Enum {
name = "__TypeKind";
doc = None;
Expand Down Expand Up @@ -522,6 +567,7 @@ module Introspection = struct
let __enum_value : 'ctx. ('ctx, any_enum_value option) typ = Object {
name = "__EnumValue";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "name";
Expand Down Expand Up @@ -568,6 +614,7 @@ module Introspection = struct
let rec __input_value : 'ctx. ('ctx, any_arg option) typ = Object {
name = "__InputValue";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "name";
Expand Down Expand Up @@ -617,6 +664,7 @@ module Introspection = struct
and __type : 'ctx . ('ctx, any_typ option) typ = Object {
name = "__Type";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "kind";
Expand All @@ -627,6 +675,8 @@ module Introspection = struct
lift = Io.ok;
resolve = fun _ t -> match t with
| AnyTyp (Object _) -> `Object
| AnyTyp (Abstract { kind = `Union; _ }) -> `Union
| AnyTyp (Abstract { kind = `Interface _; _ }) -> `Interface
| AnyTyp (List _) -> `List
| AnyTyp (Scalar _) -> `Scalar
| AnyTyp (Enum _) -> `Enum
Expand All @@ -648,6 +698,7 @@ module Introspection = struct
| AnyTyp (Object o) -> Some o.name
| AnyTyp (Scalar s) -> Some s.name
| AnyTyp (Enum e) -> Some e.name
| AnyTyp (Abstract a) -> Some a.name
| AnyArgTyp (Arg.Object o) -> Some o.name
| AnyArgTyp (Arg.Scalar s) -> Some s.name
| AnyArgTyp (Arg.Enum e) -> Some e.name
Expand All @@ -664,6 +715,7 @@ module Introspection = struct
| AnyTyp (Object o) -> o.doc
| AnyTyp (Scalar s) -> s.doc
| AnyTyp (Enum e) -> e.doc
| AnyTyp (Abstract a) -> a.doc
| AnyArgTyp (Arg.Object o) -> o.doc
| AnyArgTyp (Arg.Scalar s) -> s.doc
| AnyArgTyp (Arg.Enum e) -> e.doc
Expand All @@ -679,6 +731,8 @@ module Introspection = struct
resolve = fun _ t -> match t with
| AnyTyp (Object o) ->
Some (List.map (fun f -> AnyField f) (Lazy.force o.fields))
| AnyTyp (Abstract { kind = `Interface fields; _ }) ->
Some (List.map (fun (AbstractField f) -> AnyField f) (Lazy.force fields))
| AnyArgTyp (Arg.Object o) ->
let arg_list = args_to_list o.fields in
Some (List.map (fun (AnyArg f) -> AnyArgField f) arg_list)
Expand All @@ -688,21 +742,26 @@ module Introspection = struct
name = "interfaces";
doc = None;
deprecated = NotDeprecated;
typ = List __type;
typ = List (NonNullable __type);
args = Arg.[];
lift = Io.ok;
resolve = fun _ t -> match t with
| AnyTyp (Object _) -> Some []
| AnyTyp (Object o) ->
let interfaces = List.filter (function | { kind = `Interface _; _} -> true | _ -> false) !(o.abstracts) in
Some (List.map (fun i -> AnyTyp (Abstract i)) interfaces)
| _ -> None
};
Field {
name = "possibleTypes";
doc = None;
deprecated = NotDeprecated;
typ = List __type;
typ = List (NonNullable __type);
args = Arg.[];
lift = Io.ok;
resolve = fun _ t -> None
resolve = fun _ t -> match t with
| AnyTyp (Abstract a) ->
Some a.types
| _ -> None
};
Field {
name = "ofType";
Expand Down Expand Up @@ -748,6 +807,7 @@ module Introspection = struct
and __field : 'ctx. ('ctx, any_field option) typ = Object {
name = "__Field";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "name";
Expand Down Expand Up @@ -824,6 +884,7 @@ module Introspection = struct
let __directive = Object {
name = "__Directive";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "name";
Expand All @@ -840,6 +901,7 @@ module Introspection = struct
let __schema : 'ctx. ('ctx, 'ctx schema option) typ = Object {
name = "__Schema";
doc = None;
abstracts = no_abstracts;
fields = lazy [
Field {
name = "types";
Expand Down Expand Up @@ -909,13 +971,17 @@ end
ctx : 'ctx;
}

let matches_type_condition type_condition obj =
obj.name = type_condition ||
List.exists (fun (abstract : abstract) -> abstract.name = type_condition) !(obj.abstracts)

let rec collect_fields : fragment_map -> ('ctx, 'src) obj -> Graphql_parser.selection list -> Graphql_parser.field list = fun fragment_map obj fields ->
List.map (function
| Graphql_parser.Field field ->
[field]
| Graphql_parser.FragmentSpread spread ->
begin match StringMap.find spread.name fragment_map with
| Some fragment when obj.name = fragment.type_condition ->
| Some fragment when matches_type_condition fragment.type_condition obj ->
collect_fields fragment_map obj fragment.selection_set
| _ ->
[]
Expand All @@ -924,7 +990,7 @@ end
match fragment.type_condition with
| None ->
collect_fields fragment_map obj fragment.selection_set
| Some condition when condition = obj.name ->
| Some condition when matches_type_condition condition obj ->
collect_fields fragment_map obj fragment.selection_set
| _ -> []
) fields
Expand All @@ -948,7 +1014,7 @@ end
| Serial -> Io.map_s ~memo:[]
| Parallel -> Io.map_p

let rec present : type src. 'ctx execution_context -> src -> Graphql_parser.field -> ('ctx, src) typ -> (Yojson.Basic.json * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
let rec present : type ctx src. ctx execution_context -> src -> Graphql_parser.field -> (ctx, src) typ -> (Yojson.Basic.json * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
fun ctx src query_field typ ->
match typ with
| Scalar s -> coerce_or_null src (fun x -> Io.ok (s.coerce x, []))
Expand All @@ -971,8 +1037,12 @@ end
| Some enum_value -> Io.ok (`String enum_value.name, [])
| None -> Io.ok (`Null, [])
)
| Abstract u ->
coerce_or_null src (fun (AbstractValue (typ', src')) ->
present ctx (Some src') query_field typ'
)

and resolve_field : type src. 'ctx execution_context -> src -> Graphql_parser.field -> ('ctx, src) field -> ((string * Yojson.Basic.json) * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
and resolve_field : type ctx src. ctx execution_context -> src -> Graphql_parser.field -> (ctx, src) field -> ((string * Yojson.Basic.json) * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
fun ctx src query_field (Field field) ->
let open Io.Infix in
let name = alias_or_name query_field in
Expand All @@ -999,7 +1069,7 @@ end
| Error err ->
Io.error (`Argument_error err)

and resolve_fields : type src. 'ctx execution_context -> ?execution_order:execution_order -> src -> ('ctx, src) obj -> Graphql_parser.field list -> (Yojson.Basic.json * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
and resolve_fields : type ctx src. ctx execution_context -> ?execution_order:execution_order -> src -> (ctx, src) obj -> Graphql_parser.field list -> (Yojson.Basic.json * string list, [`Argument_error of string | `Resolve_error of string]) result Io.t =
fun ctx ?execution_order:(execution_order=Parallel) src obj fields ->
map_fields_with_order execution_order (fun (query_field : Graphql_parser.field) ->
if query_field.name = "__typename" then
Expand Down
Loading