Input unions (#32)

* basic version of input unions working

* allow any valid graphql type as input union member

* fix error messages

* docs

.ocamlformat

@@ -1,5 +1,5 @@
 profile = default
-version = 0.22.4
+version = 0.26.1
 
 field-space = tight-decl
 break-cases = toplevel

docs/docs/input-objects.md

@@ -61,3 +61,7 @@ and groupConfig = {
   additionalUserConfig?: userConfig,
 }
 ```
+
+### Input unions
+
+Often you'll find yourself in a scenario where you want to your input to be _one of_ several different values. For this, ResGraph has first class support for [input unions](input-unions).

docs/docs/input-unions.md

@@ -0,0 +1,82 @@
+---
+sidebar_position: 8
+---
+
+# Input Unions
+
+Even though they're not officially in the spec yet, ResGraph has first class support for [input unions via the `@oneOf` server directive proposal](https://github.com/graphql/graphql-spec/pull/825).
+
+Input unions are unions that can be used as inputs for fields and mutations. Input unions are regular variants in ResGraph, where the payload can be:
+
+- Any valid GraphQL type that can be used in an input position
+- An inline record
+
+Using an inline record will produce a new input object type for only this inline record.
+
+Input unions are defined by using a variant annotated with `@gql.inputUnion`. Full example:
+
+```rescript
+/** Searching for a user by group. */
+@gql.inputObject
+type userSearchByGroupConfig = {
+  groupId: ResGraph.id,
+  userMemberToken?: string,
+}
+
+/** Config for searching for a user. */
+@gql.inputUnion
+type userSearchConfig = ByGroup(userSearchByGroupConfig) | ByName(string) | ByUserToken({userToken: ResGraph.id})
+
+@gql.field
+let searchForUser = (_: query, ~input: userSearchConfig, ~ctx: ResGraphContext.context): option<user> => {
+  switch input {
+  | ByGroup({groupId, userMemberToken}) => ctx.dataLoaders.searchForUserByGroup.load(~userMemberToken, ~groupId)
+  | ByName({groupId, userMemberToken}) => ctx.dataLoaders.searchForUserByName.load(name)
+  | ByUserToken({userToken}) => ctx.dataLoaders.searchForUserByToken.load(userToken)
+  }
+
+}
+```
+
+```graphql
+"""
+Searching for a user by group.
+"""
+input UserSearchByGroupConfig {
+  groupId: ID!
+  userMemberToken: String
+}
+
+input UserSearchConfigByUserToken {
+  userToken: ID!
+}
+
+"""
+Config for searching for a user.
+"""
+input UserSearchConfig @oneOf {
+  byGroup: UserSearchByGroupConfig
+  byName: String
+  byUserToken: UserSearchConfigByUserToken
+}
+
+type Query {
+  searchForUser(input: UserSearchConfig!): User
+}
+```
+
+As with regular input objects, all fields are automatically exposed.
+
+### Comments
+
+You can add comments to the type definition itself, and to all record fields. These will then be exposed in your schema.
+
+### Handling `null`
+
+Just like in [arguments of object type fields](object-types#handling-null-in-arguments), you can choose to explicitly handle `null` values by annotating any field or member in the input union to be `Js.Nullable.t`.
+
+### Recursive input unions
+
+As with input objects, input unions are allowed to be (mutually) recursive, if they're not recursive in a non-nullable way, as that would create an endless loop.
+
+Read more [in the input object docs](input-objects).

src/ml/GenerateSchema.ml

@@ -195,9 +195,11 @@ let rec findGraphQLType ~(env : SharedTypes.QueryEnv.t) ?(typeContext = Default)
                   inputObjectFieldsOfRecordFields fields ~env ~debug ~full
                     ~schemaState;
                 description = attributesToDocstring attributes;
+                syntheticTypeLocation = None;
                 typeLocation =
-                  findTypeLocation item.name ~env ~schemaState
-                    ~loc:decl.type_loc ~expectedType:InputObject;
+                  Some
+                    (findTypeLocation item.name ~env ~schemaState
+                       ~loc:decl.type_loc ~expectedType:InputObject);
               });
           Some (GraphQLInputObject {id; displayName = capitalizeFirstChar id})
         | Some Interface, {name; kind = Record fields; attributes; decl} ->
@@ -247,6 +249,33 @@ let rec findGraphQLType ~(env : SharedTypes.QueryEnv.t) ?(typeContext = Default)
                     ~expectedType:Union id;
               });
           Some (GraphQLUnion {id; displayName})
+        | Some InputUnion, {name; kind = Variant cases} ->
+          let id = name in
+          let displayName = capitalizeFirstChar id in
+          addInputUnion id ~schemaState ~debug ~makeInputUnion:(fun () ->
+              {
+                id;
+                displayName;
+                members =
+                  variantCasesToInputUnionValues cases ~env ~full ~schemaState
+                    ~debug ~ownerName:displayName;
+                description = item.attributes |> attributesToDocstring;
+                typeLocation =
+                  findTypeLocation ~loc:item.decl.type_loc ~schemaState ~env
+                    ~expectedType:InputUnion id;
+              });
+          Some
+            (GraphQLInputUnion
+               {
+                 id;
+                 displayName;
+                 inlineRecords =
+                   cases
+                   |> List.filter_map (fun (c : SharedTypes.Constructor.t) ->
+                          match c.args with
+                          | InlineRecord _ -> Some c.cname.txt
+                          | _ -> None);
+               })
         | Some (InterfaceResolver {interfaceId}), {kind = Variant _} ->
           Some
             (GraphQLInterface
@@ -360,7 +389,7 @@ and variantCasesToUnionValues ~env ~debug ~schemaState ~full ~ownerName
                |> objectTypeFieldsOfInlineRecordFields ~env ~full ~schemaState
                     ~debug)
              ~loc:case.cname.loc;
-           Some
+           let member : gqlUnionMember =
              {
                objectTypeId = id;
                displayName = syntheticTypeName;
@@ -369,6 +398,8 @@ and variantCasesToUnionValues ~env ~debug ~schemaState ~full ~ownerName
                  case.attributes |> ProcessAttributes.findDocAttribute;
                constructorName = case.cname.txt;
              }
+           in
+           Some member
          | Args [(typ, _)] -> (
            match
              findGraphQLType ~debug ~loc:case.cname.loc ~env ~schemaState ~full
@@ -392,9 +423,9 @@ and variantCasesToUnionValues ~env ~debug ~schemaState ~full ~ownerName
                    message =
                      Printf.sprintf
                        "The payload of the variant case `%s` of the GraphQL \
-                        union variant `%s` is not a GraphL object. The payload \
-                        needs to be a single type representing a GraphQL \
-                        object, meaning it's annotated with @gql.type."
+                        union variant `%s` is not a GraphQL object. The \
+                        payload needs to be a single type representing a \
+                        GraphQL object, meaning it's annotated with @gql.type."
                        case.cname.txt (case.typeDecl |> fst);
                    fileUri = env.file.uri;
                  };
@@ -415,6 +446,89 @@ and variantCasesToUnionValues ~env ~debug ~schemaState ~full ~ownerName
                };
            None)
 
+and variantCasesToInputUnionValues ~env ~debug ~schemaState ~full ~ownerName
+    (cases : SharedTypes.Constructor.t list) =
+  cases
+  |> List.filter_map (fun (case : SharedTypes.Constructor.t) ->
+         match case.args with
+         | InlineRecord fields ->
+           let syntheticTypeName = ownerName ^ case.cname.txt in
+           let id = syntheticTypeName in
+           let displayName = capitalizeFirstChar id in
+           addInputObject id ~schemaState ~debug ~makeInputObject:(fun () ->
+               {
+                 id;
+                 displayName = capitalizeFirstChar id;
+                 fields =
+                   fields
+                   |> objectTypeFieldsOfInlineRecordFields ~env ~full
+                        ~schemaState ~debug;
+                 description = None;
+                 typeLocation = None;
+                 syntheticTypeLocation =
+                   Some {fileUri = env.file.uri; loc = case.cname.loc};
+               });
+           let member : gqlInputUnionMember =
+             {
+               typ = GraphQLInputObject {displayName; id};
+               fieldName = uncapitalizeFirstChar case.cname.txt;
+               loc = case.cname.loc;
+               description =
+                 case.attributes |> ProcessAttributes.findDocAttribute;
+               constructorName = case.cname.txt;
+             }
+           in
+           Some member
+         | Args [(typ, _)] -> (
+           (* TODO: Validate more that only input types are present. *)
+           match
+             findGraphQLType ~debug ~loc:case.cname.loc ~env ~schemaState ~full
+               typ
+           with
+           | Some
+               (( List _ | Nullable _ | RescriptNullable _ | Scalar _
+                | GraphQLInputObject _ | GraphQLInputUnion _ | GraphQLEnum _
+                | GraphQLScalar _ ) as typ) ->
+             Some
+               {
+                 typ;
+                 fieldName = uncapitalizeFirstChar case.cname.txt;
+                 loc = case.cname.loc;
+                 description =
+                   case.attributes |> ProcessAttributes.findDocAttribute;
+                 constructorName = case.cname.txt;
+               }
+           | _ ->
+             addDiagnostic schemaState
+               ~diagnostic:
+                 {
+                   loc = case.cname.loc;
+                   message =
+                     Printf.sprintf
+                       "The payload of the variant case `%s` of the GraphQL \
+                        input union variant `%s` is not a valid GraphQL type. \
+                        The payload needs to be a single type representing a \
+                        valid GraphQL type."
+                       case.cname.txt (case.typeDecl |> fst);
+                   fileUri = env.file.uri;
+                 };
+             None)
+         | _ ->
+           addDiagnostic schemaState
+             ~diagnostic:
+               {
+                 loc = case.cname.loc;
+                 message =
+                   Printf.sprintf
+                     "The payload of the variant case `%s` of the GraphQL \
+                      input union variant `%s` is not a single payload. The \
+                      payload needs to be a single type representing a valid \
+                      GraphQL type."
+                     case.cname.txt (case.typeDecl |> fst);
+                 fileUri = env.file.uri;
+               };
+           None)
+
 and objectTypeFieldsOfRecordFields ~env ~schemaState ~debug
     ~(full : SharedTypes.full) (fields : SharedTypes.field list) =
   fields
@@ -638,9 +752,11 @@ and traverseStructure ?(modulePath = []) ?implStructure ?originModule
                      inputObjectFieldsOfRecordFields fields ~env ~full
                        ~schemaState ~debug;
                    description = attributesToDocstring attributes;
+                   syntheticTypeLocation = None;
                    typeLocation =
-                     findTypeLocation item.name ~env ~schemaState
-                       ~loc:decl.type_loc ~expectedType:InputObject;
+                     Some
+                       (findTypeLocation item.name ~env ~schemaState
+                          ~loc:decl.type_loc ~expectedType:InputObject);
                  })
            | Type ({kind = Record fields; attributes; decl}, _), Some Interface
              ->
@@ -689,6 +805,23 @@ and traverseStructure ?(modulePath = []) ?implStructure ?originModule
                        ~expectedType:Union item.name;
                  })
                ~schemaState ~debug
+           | Type (({kind = Variant cases} as item), _), Some InputUnion ->
+             (* @gql.inputUnion type location = Coordinates(coordinates) | Address(address) *)
+             let displayName = capitalizeFirstChar item.name in
+             addInputUnion item.name
+               ~makeInputUnion:(fun () ->
+                 {
+                   id = item.name;
+                   displayName;
+                   description = item.attributes |> attributesToDocstring;
+                   members =
+                     variantCasesToInputUnionValues cases ~env ~full
+                       ~schemaState ~debug ~ownerName:displayName;
+                   typeLocation =
+                     findTypeLocation ~loc:item.decl.type_loc ~env ~schemaState
+                       ~expectedType:InputUnion item.name;
+                 })
+               ~schemaState ~debug
            | Type (({name = "t"} as item), _), Some Scalar -> (
              (* module Timestamp = { @gql.scalar type t = string } *)
              (* module Timestamp: {@gql.scalar type t } = { type t = string } *)
@@ -983,6 +1116,17 @@ and traverseStructure ?(modulePath = []) ?implStructure ?originModule
                           not a record. Only records can represent GraphQL \
                           input objects.";
                    }
+             | Some InputUnion ->
+               add
+                 ~diagnostic:
+                   {
+                     baseDiagnostic with
+                     message =
+                       Printf.sprintf
+                         "This type is annotated with @gql.inputUnion, but is \
+                          not a variant. Only variants can represent GraphQL \
+                          input union.";
+                   }
              | Some Enum ->
                add
                  ~diagnostic:
@@ -1056,6 +1200,7 @@ let generateSchema ~printToStdOut ~writeStateFile ~sourceFolder ~debug
       enums = Hashtbl.create 10;
       unions = Hashtbl.create 10;
       inputObjects = Hashtbl.create 10;
+      inputUnions = Hashtbl.create 10;
       interfaces = Hashtbl.create 10;
       scalars = Hashtbl.create 10;
       query = None;
@@ -1160,8 +1305,8 @@ let generateSchema ~printToStdOut ~writeStateFile ~sourceFolder ~debug
       GenerateSchemaUtils.writeStateFile ~package ~schemaState ~processedSchema;
 
     (if writeSdlFile then
-     let sdl = GenerateSchemaSDL.printSchemaSDL schemaState in
-     GenerateSchemaUtils.writeIfHasChanges sdlOutputPath sdl);
+       let sdl = GenerateSchemaSDL.printSchemaSDL schemaState in
+       GenerateSchemaUtils.writeIfHasChanges sdlOutputPath sdl);
 
     (* Write generated schema *)
     (* Write implementation file *)

src/ml/GenerateSchemaSDL.ml

@@ -21,6 +21,7 @@ let rec graphqlTypeToString ?(nullable = false) (t : graphqlType) =
   | GraphQLInputObject {displayName}
   | GraphQLEnum {displayName}
   | GraphQLUnion {displayName}
+  | GraphQLInputUnion {displayName}
   | GraphQLInterface {displayName}
   | GraphQLScalar {displayName} ->
     Printf.sprintf "%s%s" displayName nullableSuffix
@@ -62,13 +63,13 @@ let printFields fields =
            (printDescription f.description 2)
            f.name
            (if List.length args > 0 then
-            Printf.sprintf "(%s)"
-              (args
-              |> List.map (fun (arg : gqlArg) ->
-                     Printf.sprintf "%s: %s" arg.name
-                       (graphqlTypeToString arg.typ))
-              |> String.concat ", ")
-           else "")
+              Printf.sprintf "(%s)"
+                (args
+                |> List.map (fun (arg : gqlArg) ->
+                       Printf.sprintf "%s: %s" arg.name
+                         (graphqlTypeToString arg.typ))
+                |> String.concat ", ")
+            else "")
            (graphqlTypeToString f.typ)
            (printDeprecatedDirective f.deprecationReason))
   |> String.concat "\n"
@@ -94,7 +95,15 @@ let printInputObject (input : gqlInputObjectType) =
   Printf.sprintf "%sinput %s%s {\n%s\n}"
     (printDescription input.description 0)
     input.displayName
-    (printSourceLocDirective (Some input.typeLocation))
+    (printSourceLocDirective input.typeLocation)
+    (printFields input.fields)
+
+let printInputUnion (input : gqlInputUnionType) =
+  let input = inputUnionToInputObj input in
+  Printf.sprintf "%sinput %s%s @oneOf {\n%s\n}"
+    (printDescription input.description 0)
+    input.displayName
+    (printSourceLocDirective input.typeLocation)
     (printFields input.fields)
 
 let printScalar (scalar : gqlScalar) =
@@ -173,6 +182,10 @@ let printSchemaSDL (schemaState : schemaState) =
   |> iterHashtblAlphabetically (fun _name (input : gqlInputObjectType) ->
          addSection (printInputObject input));
 
+  schemaState.inputUnions
+  |> iterHashtblAlphabetically (fun _name (input : gqlInputUnionType) ->
+         addSection (printInputUnion input));
+
   schemaState.interfaces
   |> iterHashtblAlphabetically (fun _name (intf : gqlInterface) ->
          addSection (printInterface intf));