GenType: support @deriving(accessors) (rescript-lang#6537)

* GenType: support `@deriving(accessors)` outputs * [skip ci] changelog * changed to not recycle loc unintentinonlly

Author: cometkim

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 11.0.0-rc.9 (Unreleased)
 
+#### :rocket: New Feature
+
+- GenType: support `@deriving(accessors)` outputs. https://github.com/rescript-lang/rescript-compiler/pull/6537
+
 # 11.0.0-rc.8
 
 #### :rocket: New Feature

jscomp/frontend/ast_attributes.ml

@@ -373,3 +373,10 @@ let bs_return_undefined : attr =
  pstr_loc = locg;
  };
  ] )
+
+let is_gentype (attr : attr) =
+ match attr with
+ | {Location.txt = "genType" | "gentype"; _}, _ -> true
+ | _ -> false
+
+let gentype : attr = ({txt = "genType"; loc = locg}, Ast_payload.empty)

jscomp/frontend/ast_attributes.mli

@@ -90,3 +90,7 @@ val internal_expansive : attr
 val rs_externals : t -> string list -> bool
 
 val process_send_pipe : t -> (Parsetree.core_type * t) option
+
+val is_gentype : attr -> bool
+
+val gentype : attr

jscomp/frontend/ast_comb.ml

@@ -62,7 +62,7 @@ let to_js_re_type loc = Typ.constr ~loc {txt = re_id; loc} []
 let to_undefined_type loc x =
  Typ.constr ~loc {txt = Ast_literal.Lid.js_undefined; loc} [x]
 
-let single_non_rec_value name exp =
- Str.value Nonrecursive [Vb.mk (Pat.var name) exp]
+let single_non_rec_value ?(attrs = []) name exp =
+ Str.value Nonrecursive [Vb.mk ~attrs (Pat.var name) exp]
 
-let single_non_rec_val name ty = Sig.value (Val.mk name ty)
+let single_non_rec_val ?(attrs = []) name ty = Sig.value (Val.mk ~attrs name ty)

jscomp/frontend/ast_comb.mli

@@ -42,7 +42,13 @@ val to_undefined_type : Location.t -> Parsetree.core_type -> Parsetree.core_type
 val to_js_re_type : Location.t -> Parsetree.core_type
 
 val single_non_rec_value :
- Ast_helper.str -> Parsetree.expression -> Parsetree.structure_item
+ ?attrs:Parsetree.attributes ->
+ Ast_helper.str ->
+ Parsetree.expression ->
+ Parsetree.structure_item
 
 val single_non_rec_val :
- Ast_helper.str -> Parsetree.core_type -> Parsetree.signature_item
+ ?attrs:Parsetree.attributes ->
+ Ast_helper.str ->
+ Parsetree.core_type ->
+ Parsetree.signature_item

jscomp/frontend/ast_derive_projector.ml

@@ -18,6 +18,14 @@ let init () =
  let core_type =
  Ast_derive_util.core_type_of_type_declaration tdcl
  in
+ let gentype_attrs =
+ match
+ Ext_list.exists core_type.ptyp_attributes
+ Ast_attributes.is_gentype
+ with
+ | true -> Some [Ast_attributes.gentype]
+ | false -> None
+ in
  match tdcl.ptype_kind with
  | Ptype_record label_declarations ->
  Ext_list.map label_declarations
@@ -26,7 +34,7 @@ let init () =
  Parsetree.label_declaration)
  ->
  let txt = "param" in
- Ast_comb.single_non_rec_value pld_name
+ Ast_comb.single_non_rec_value ?attrs:gentype_attrs pld_name
  (Ast_compatible.fun_
  (Pat.constraint_ (Pat.var {txt; loc}) core_type)
  (Exp.field
@@ -57,7 +65,7 @@ let init () =
  | None -> core_type
  | Some x -> x
  in
- Ast_comb.single_non_rec_value
+ Ast_comb.single_non_rec_value ?attrs:gentype_attrs
  {loc; txt = little_con_name}
  (if arity = 0 then
  (*TODO: add a prefix, better inter-op with FFI *)
@@ -99,10 +107,18 @@ let init () =
  let core_type =
  Ast_derive_util.core_type_of_type_declaration tdcl
  in
+ let gentype_attrs =
+ match
+ Ext_list.exists core_type.ptyp_attributes
+ Ast_attributes.is_gentype
+ with
+ | true -> Some [Ast_attributes.gentype]
+ | false -> None
+ in
  match tdcl.ptype_kind with
  | Ptype_record label_declarations ->
  Ext_list.map label_declarations (fun {pld_name; pld_type} ->
- Ast_comb.single_non_rec_val pld_name
+ Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name
  (Ast_compatible.arrow core_type pld_type))
  | Ptype_variant constructor_declarations ->
  Ext_list.map constructor_declarations
@@ -124,7 +140,7 @@ let init () =
  | Some x -> x
  | None -> core_type
  in
- Ast_comb.single_non_rec_val
+ Ast_comb.single_non_rec_val ?attrs:gentype_attrs
  {loc; txt = Ext_string.uncapitalize_ascii con_name}
  (Ext_list.fold_right pcd_args annotate_type (fun x acc ->
  Ast_compatible.arrow x acc)))

jscomp/frontend/ast_derive_util.ml

@@ -26,8 +26,8 @@ open Ast_helper
 
 let core_type_of_type_declaration (tdcl : Parsetree.type_declaration) =
  match tdcl with
- | {ptype_name = {txt; loc}; ptype_params} ->
- Typ.constr {txt = Lident txt; loc} (Ext_list.map ptype_params fst)
+ | {ptype_name = {txt; loc}; ptype_params; ptype_attributes = attrs} ->
+ Typ.constr ~attrs {txt = Lident txt; loc} (Ext_list.map ptype_params fst)
 
 let new_type_of_type_declaration (tdcl : Parsetree.type_declaration) newName =
  match tdcl with

jscomp/gentype_tests/typescript-react-example/src/Derivings.bs.js

@@ -0,0 +1,17 @@
+/* TypeScript file generated from Derivings.res by genType. */
+
+/* eslint-disable */
+/* tslint:disable */
+
+import * as DerivingsBS from './Derivings.bs';
+
+export type action = 
+ "Click"
+ | "Cancel"
+ | { TAG: "Submit"; _0: string };
+
+export const click: action = DerivingsBS.click as any;
+
+export const submit: (_1:string) => action = DerivingsBS.submit as any;
+
+export const cancel: action = DerivingsBS.cancel as any;

jscomp/gentype_tests/typescript-react-example/src/Derivings.gen.tsx

@@ -0,0 +1,5 @@
+@genType @deriving(accessors)
+type action =
+ | Click
+ | Submit(string)
+ | Cancel