Support @as for reserved record fields (#42)

Author: zth

src/ml/GenerateSchema.ml

@@ -782,7 +782,7 @@ and inputObjectFieldsOfRecordFields ~objectTypeName ~env ~debug ~schemaState
     ~(full : SharedTypes.full) (fields : SharedTypes.field list) =
   fields
   |> List.filter_map (fun (field : SharedTypes.field) ->
-      let name = field.fname.txt in
+      let name = nameFromAttribute field.attributes ~default:field.fname.txt in
       match
         findGraphQLType field.typ ~debug ~loc:field.fname.loc ~full ~env
           ~schemaState
@@ -992,11 +992,11 @@ and objectTypeFieldsOfRecordFields ~objectTypeName ~env ~schemaState ~debug
       | Some attr -> Some (field, attr))
   |> List.filter_map (fun ((field : SharedTypes.field), _attr) ->
       let fieldType = field.typ in
+      let name = nameFromAttribute field.attributes ~default:field.fname.txt in
       let typ =
         findGraphQLType fieldType ~debug ~loc:field.fname.loc ~full ~env
           ~schemaState
-          ~typeContext:
-            (ObjectField {objectTypeName; fieldName = field.fname.txt})
+          ~typeContext:(ObjectField {objectTypeName; fieldName = name})
       in
       match typ with
       | None ->
@@ -1017,7 +1017,6 @@ and objectTypeFieldsOfRecordFields ~objectTypeName ~env ~schemaState ~debug
                };
         None
       | Some typ ->
-        let name = field.fname.txt in
         Some
           {
             name;
@@ -1037,11 +1036,11 @@ and objectTypeFieldsOfInlineRecordFields ~objectTypeName ~env ~schemaState
   fields
   |> List.filter_map (fun (field : SharedTypes.field) ->
       let fieldType = field.typ in
+      let name = nameFromAttribute field.attributes ~default:field.fname.txt in
       let typ =
         findGraphQLType fieldType ~debug ~loc:field.fname.loc ~full ~env
           ~schemaState
-          ~typeContext:
-            (ObjectField {objectTypeName; fieldName = field.fname.txt})
+          ~typeContext:(ObjectField {objectTypeName; fieldName = name})
       in
       match typ with
       | None ->
@@ -1062,7 +1061,6 @@ and objectTypeFieldsOfInlineRecordFields ~objectTypeName ~env ~schemaState
                };
         None
       | Some typ ->
-        let name = field.fname.txt in
         Some
           {
             name;

src/ml/GenerateSchemaValidation.ml

@@ -37,7 +37,31 @@ let validateName ~name ~(typeLocation : typeLocation)
                    name;
              }
 
-let validateFields ~schemaState (fields : gqlField list) =
+let validateFieldNameUniqueness ~schemaState ~(parentTypeName : string)
+    (fields : gqlField list) =
+  let seen = Hashtbl.create (List.length fields) in
+  fields
+  |> List.iter (fun (field : gqlField) ->
+      match Hashtbl.find_opt seen field.name with
+      | None -> Hashtbl.add seen field.name field
+      | Some firstField ->
+        schemaState
+        |> addDiagnostic
+             ~diagnostic:
+               {
+                 loc = field.loc;
+                 fileUri = field.fileUri;
+                 message =
+                   Printf.sprintf
+                     "Field `%s` appears more than once on GraphQL type `%s`. \
+                      Rename one of the fields or change its @as attribute. \
+                      The first field was declared in %s."
+                     field.name parentTypeName firstField.fileName;
+               })
+
+let validateFields ~schemaState ~(parentTypeName : string)
+    (fields : gqlField list) =
+  validateFieldNameUniqueness ~schemaState ~parentTypeName fields;
   fields
   |> List.iter (fun (f : gqlField) ->
       validateName ~name:f.name
@@ -69,16 +93,11 @@ let validateSchema (schemaState : schemaState) =
 
   schemaState.types
   |> Hashtbl.iter (fun _name (typ : gqlObjectType) ->
-      match typ.typeLocation with
-      | Some _typeLocation -> validateFields ~schemaState typ.fields
-      | None -> ());
+      validateFields ~schemaState ~parentTypeName:typ.displayName typ.fields);
 
   schemaState.inputObjects
   |> Hashtbl.iter (fun _name (typ : gqlInputObjectType) ->
-      (* A lot has already been validated on adding the type itself. *)
-      match typ.typeLocation with
-      | Some _typeLocation -> validateFields ~schemaState typ.fields
-      | None -> ());
+      validateFields ~schemaState ~parentTypeName:typ.displayName typ.fields);
 
   schemaState.enums
   |> Hashtbl.iter (fun _name (typ : gqlEnum) ->
@@ -96,4 +115,4 @@ let validateSchema (schemaState : schemaState) =
   |> Hashtbl.iter (fun _name (typ : gqlInterface) ->
       (* Subtype rules etc for interface fields are a bit complicated, so we
             let graphql-js do it at runtime instead. *)
-      validateFields ~schemaState typ.fields)
+      validateFields ~schemaState ~parentTypeName:typ.displayName typ.fields)

tests/runtime-interface-returns.mjs

@@ -101,4 +101,44 @@ assert.match(
   /Interface Labelled resolveType expected a tagged value from Interface_labelled\.Resolver\.t/,
 );
 
-console.log("runtime interface return regressions passed");
+const reservedWords = await run(`
+  query ReservedWords {
+    reservedWordRecord {
+      constraint
+      external
+      include
+      let
+      module
+      open
+      switch
+      type
+    }
+  }
+`);
+
+assert.equal(reservedWords.errors, undefined);
+assert.deepEqual(plain(reservedWords.data), {
+  reservedWordRecord: {
+    constraint: "constraint",
+    external: "external",
+    include: "include",
+    let: "let",
+    module: "module",
+    open: "open",
+    switch: "switch",
+    type: "type",
+  },
+});
+
+const reservedInput = await run(`
+  query ReservedInput {
+    reservedWordInputEcho(input: {constraint: "input constraint", type: "input type"})
+  }
+`);
+
+assert.equal(reservedInput.errors, undefined);
+assert.deepEqual(plain(reservedInput.data), {
+  reservedWordInputEcho: "input constraint:input type",
+});
+
+console.log("runtime regressions passed");

tests/src/AppReScript12.res

@@ -5,8 +5,7 @@ type res12Record = {
   @gql.field
   withDoc: string,
   /** Deprecated attribute should survive too. */
-  @deprecated("old field")
-  @gql.field
+  @deprecated("old field") @gql.field
   oldField: int,
 }
 
@@ -18,3 +17,48 @@ type res12Input =
       payload: string,
     })
   | Empty
+
+/** Reserved ReScript field names can be exposed as GraphQL names. */
+@gql.type
+type reservedWordRecord = {
+  @as("constraint") @gql.field
+  constraint_: string,
+  @as("external") @gql.field
+  external_: string,
+  @as("include") @gql.field
+  include_: string,
+  @as("let") @gql.field
+  let_: string,
+  @as("module") @gql.field
+  module_: string,
+  @as("open") @gql.field
+  open_: string,
+  @as("switch") @gql.field
+  switch_: string,
+  @as("type") @gql.field
+  type_: string,
+}
+
+@gql.inputObject
+type reservedWordInput = {
+  @as("constraint")
+  constraint_: string,
+  @as("type")
+  type_: string,
+}
+
+@gql.field
+let reservedWordRecord = (_: Query.query): reservedWordRecord => {
+  constraint_: "constraint",
+  external_: "external",
+  include_: "include",
+  let_: "let",
+  module_: "module",
+  open_: "open",
+  switch_: "switch",
+  type_: "type",
+}
+
+@gql.field
+let reservedWordInputEcho = (_: Query.query, ~input: reservedWordInput) =>
+  input.constraint_ ++ ":" ++ input.type_