Skip to content

Commit 1b7ec6b

Browse files
zthzth
committed
some tweaking of the structure, and explore an exact output mode
1 parent ee575f9 commit 1b7ec6b

File tree

19 files changed

+2301
-133
lines changed

19 files changed

+2301
-133
lines changed

‎compiler/gentype/Annotation.ml‎

Lines changed: 43 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@ type attribute_payload =
77
| IntPayload of string
88
| StringPayload of string
99
| TuplePayload of attribute_payload list
10+
| RecordPayload of (string * attribute_payload) list
1011
| UnrecognizedPayload
1112

1213
type t = GenType | GenTypeOpaque | NoGenType
@@ -63,6 +64,26 @@ let rec get_attribute_payload check_text (attributes : Typedtree.attributes) =
6364
[]
6465
in
6566
Some (TuplePayload payloads)
67+
| {pexp_desc = Pexp_record (fields, _)} ->
68+
let items =
69+
fields
70+
|> List.fold_left
71+
(fun acc
72+
({Parsetree.lid; x; _} :
73+
Parsetree.expression Parsetree.record_element) ->
74+
let key_opt =
75+
match lid.Location.txt with
76+
| Longident.Lident s -> Some s
77+
| Longident.Ldot (_, s) -> Some s
78+
| _ -> None
79+
in
80+
match (key_opt, from_expr x) with
81+
| Some key, Some v -> (key, v) :: acc
82+
| _ -> acc)
83+
[]
84+
|> List.rev
85+
in
86+
Some (RecordPayload items)
6687
| {pexp_desc = Pexp_ident {txt}} -> Some (IdentPayload txt)
6788
| _ -> None
6889
in
@@ -138,14 +159,33 @@ let get_attribute_import_renaming attributes =
138159
let gentype_as_renaming = attributes |> get_gentype_as_renaming in
139160
match (attribute_import, gentype_as_renaming) with
140161
| Some (_, StringPayload import_string), _ ->
141-
(Some import_string, gentype_as_renaming)
162+
(Some import_string, gentype_as_renaming, None, None)
142163
| ( Some
143164
( _,
144165
TuplePayload
145166
[StringPayload import_string; StringPayload rename_string] ),
146167
_ ) ->
147-
(Some import_string, Some rename_string)
148-
| _ -> (None, gentype_as_renaming)
168+
(* Tuple form encodes (importPath, remoteExportName). Keep remote name separate. *)
169+
(Some import_string, gentype_as_renaming, None, Some rename_string)
170+
| Some (_, RecordPayload opts), _ ->
171+
let import_tuple_opt = List.assoc_opt "importPath" opts in
172+
let import_string_opt, rename_string_opt =
173+
match import_tuple_opt with
174+
| Some (TuplePayload [StringPayload import_string; StringPayload rename])
175+
->
176+
(Some import_string, Some rename)
177+
| Some (TuplePayload [StringPayload import_string]) ->
178+
(Some import_string, None)
179+
| _ -> (None, None)
180+
in
181+
let exact_opt =
182+
match List.assoc_opt "exact" opts with
183+
| Some (BoolPayload b) -> Some b
184+
| _ -> None
185+
in
186+
(* Keep remote export name separate from local alias (@genType.as) *)
187+
(import_string_opt, gentype_as_renaming, exact_opt, rename_string_opt)
188+
| _ -> (None, gentype_as_renaming, None, None)
149189

150190
let get_tag attributes =
151191
match attributes |> get_attribute_payload tag_is_tag with

‎compiler/gentype/CodeItem.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,7 @@ type export_type_map = export_type_item StringMap.t
4747
type type_declaration = {
4848
export_from_type_declaration: export_from_type_declaration;
4949
import_types: import_type list;
50+
expected_type: type_ option;
5051
}
5152

5253
type t = ExportValue of export_value | ImportValue of import_value

‎compiler/gentype/EmitJs.ml‎

Lines changed: 56 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -635,16 +635,56 @@ let emit_translation_as_string ~(config : Config.t) ~file_name
635635
|> List.map (fun (type_declaration : CodeItem.type_declaration) ->
636636
type_declaration.export_from_type_declaration)
637637
in
638-
(* Determine if we need to emit the helper alias for $GenTypeImport. *)
639-
let needs_gentype_import_helper =
638+
(* Emit a named alias for the ReScript-side expected shape to improve TS errors. *)
639+
let emitters =
640+
let type_name_is_interface =
641+
type_name_is_interface ~export_type_map
642+
~export_type_map_from_other_files:
643+
initial_env.export_type_map_from_other_files
644+
in
645+
annotated_type_declarations
646+
|> List.fold_left
647+
(fun emitters (td : CodeItem.type_declaration) ->
648+
match td.expected_type with
649+
| None -> emitters
650+
| Some expected
651+
when GentypeImportHelper.should_inline_expected expected ->
652+
emitters
653+
| Some expected ->
654+
let ({CodeItem.export_type}
655+
: CodeItem.export_from_type_declaration) =
656+
td.export_from_type_declaration
657+
in
658+
let alias_name =
659+
(export_type.resolved_type_name |> ResolvedName.to_string)
660+
^ "$ReScript"
661+
in
662+
let type_params_string =
663+
EmitText.generics_string ~type_vars:export_type.type_vars
664+
in
665+
let expected_string =
666+
EmitType.type_to_string ~config ~type_name_is_interface expected
667+
in
668+
Emitters.export_early ~emitters
669+
("type " ^ alias_name ^ type_params_string ^ " = "
670+
^ expected_string ^ ";"))
671+
Emitters.initial
672+
in
673+
(* Determine if we need to emit the helper alias(es) for $GenTypeImport. *)
674+
let needs_gentype_import_helper, needs_gentype_import_strict_helper =
640675
export_from_type_declarations
641-
|> List.exists
642-
(fun
643-
({CodeItem.export_type} : CodeItem.export_from_type_declaration) ->
676+
|> List.fold_left
677+
(fun (need_std, need_strict)
678+
({CodeItem.export_type} : CodeItem.export_from_type_declaration)
679+
->
644680
match export_type.type_ with
645681
| Ident {name; _} when String.equal name GentypeImportHelper.name ->
646-
true
647-
| _ -> false)
682+
(true, need_strict)
683+
| Ident {name; _}
684+
when String.equal name GentypeImportHelper.strict_name ->
685+
(need_std, true)
686+
| _ -> (need_std, need_strict))
687+
(false, false)
648688
in
649689
let type_name_is_interface ~env =
650690
type_name_is_interface ~export_type_map
@@ -654,7 +694,7 @@ let emit_translation_as_string ~(config : Config.t) ~file_name
654694
try export_type_map |> StringMap.find s
655695
with Not_found -> env.export_type_map_from_other_files |> StringMap.find s
656696
in
657-
let emitters = Emitters.initial
697+
let emitters = emitters
658698
and module_items_emitter = ExportModule.create_module_items_emitter ()
659699
and env = initial_env in
660700
let env, emitters =
@@ -738,10 +778,15 @@ let emit_translation_as_string ~(config : Config.t) ~file_name
738778
module_items_emitter
739779
|> ExportModule.emit_all_module_items ~config ~emitters ~file_name
740780
in
741-
(* If we used the $GenTypeImport wrapper, emit its helper alias early. *)
781+
(* If we used the $GenTypeImport wrapper(s), emit helper alias(es) early. *)
742782
let emitters =
743-
if needs_gentype_import_helper then
744-
Emitters.export_early ~emitters GentypeImportHelper.alias
783+
let emitters =
784+
if needs_gentype_import_helper then
785+
Emitters.export_early ~emitters GentypeImportHelper.alias
786+
else emitters
787+
in
788+
if needs_gentype_import_strict_helper then
789+
Emitters.export_early ~emitters GentypeImportHelper.strict_alias
745790
else emitters
746791
in
747792
emitters

‎compiler/gentype/GentypeImportHelper.ml‎

Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,21 @@
1+
open GenTypeCommon
2+
13
let name = "$GenTypeImport"
24

35
let alias = "type $GenTypeImport<Expected, T extends Expected> = T;"
6+
7+
let strict_name = "$GenTypeImportStrict"
8+
9+
let strict_alias =
10+
"type $GenTypeImportStrict<T, Expected extends T> = Expected;"
11+
12+
let rec should_inline_expected (t : type_) : bool =
13+
match t with
14+
| Ident {builtin = true; name; _} -> (
15+
match name with
16+
| "number" | "string" | "boolean" -> true
17+
| _ -> false)
18+
| Tuple inner -> inner |> List.for_all should_inline_expected
19+
| Array (t, _) -> should_inline_expected t
20+
| Promise t -> should_inline_expected t
21+
| _ -> false

‎compiler/gentype/TranslateTypeDeclarations.ml‎

Lines changed: 91 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
5959
| false -> None
6060
(* one means don't know *)
6161
in
62-
let import_string_opt, name_as =
62+
let import_string_opt, name_as, import_exact_opt, remote_export_name_opt =
6363
type_attributes |> Annotation.get_attribute_import_renaming
6464
in
6565
let unboxed_annotation =
@@ -83,7 +83,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
8383
|> Translation.translate_dependencies ~config ~output_file_relative
8484
~resolver
8585
in
86-
{CodeItem.import_types; export_from_type_declaration}
86+
{CodeItem.import_types; export_from_type_declaration; expected_type = None}
8787
in
8888
let translate_label_declarations ?(inline = false) label_declarations =
8989
let field_translations =
@@ -146,11 +146,15 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
146146
let name_with_module_path =
147147
typeName_ |> TypeEnv.add_module_path ~type_env |> ResolvedName.to_string
148148
in
149-
let type_name, as_type_name =
150-
match name_as with
151-
| Some as_string -> (as_string, "$$" ^ name_with_module_path)
152-
| None -> (name_with_module_path, "$$" ^ name_with_module_path)
149+
(* Use the remote export name (if provided) to build the import and alias.
150+
Preserve casing from the TS source exactly. *)
151+
let remote_type_name =
152+
match remote_export_name_opt with
153+
| Some s -> s
154+
| None -> name_with_module_path
153155
in
156+
let type_name = remote_type_name in
157+
let as_type_name = remote_type_name ^ "$TypeScript" in
154158
let import_path = import_string |> ImportPath.from_string_unsafe in
155159
let base_import =
156160
{CodeItem.type_name; as_type_name = Some as_type_name; import_path}
@@ -167,6 +171,59 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
167171
(type_expr
168172
|> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config
169173
~type_env)
174+
| RecordDeclarationFromTypes label_declarations ->
175+
Some (label_declarations |> translate_label_declarations)
176+
| VariantDeclarationFromTypes constructor_declarations ->
177+
let variants =
178+
constructor_declarations
179+
|> List.map (fun constructor_declaration ->
180+
let constructor_args = constructor_declaration.Types.cd_args in
181+
let attributes = constructor_declaration.cd_attributes in
182+
let name = constructor_declaration.cd_id |> Ident.name in
183+
let args_translation =
184+
match constructor_args with
185+
| Cstr_tuple type_exprs ->
186+
type_exprs
187+
|> TranslateTypeExprFromTypes
188+
.translate_type_exprs_from_types ~config ~type_env
189+
| Cstr_record label_declarations ->
190+
[
191+
label_declarations
192+
|> translate_label_declarations ~inline:true;
193+
]
194+
in
195+
let arg_types =
196+
args_translation
197+
|> List.map (fun {TranslateTypeExprFromTypes.type_} -> type_)
198+
in
199+
(name, attributes, arg_types))
200+
in
201+
let variants_no_payload, variants_with_payload =
202+
variants |> List.partition (fun (_, _, arg_types) -> arg_types = [])
203+
in
204+
let no_payloads =
205+
variants_no_payload
206+
|> List.map (fun (name, attributes, _argTypes) ->
207+
(name, attributes) |> create_case ~poly:false)
208+
in
209+
let payloads =
210+
variants_with_payload
211+
|> List.map (fun (name, attributes, arg_types) ->
212+
let type_ =
213+
match arg_types with
214+
| [type_] -> type_
215+
| _ -> Tuple arg_types
216+
in
217+
{
218+
case = (name, attributes) |> create_case ~poly:false;
219+
t = type_;
220+
})
221+
in
222+
let variant_typ =
223+
create_variant ~inherits:[] ~no_payloads ~payloads ~polymorphic:false
224+
~tag:tag_annotation ~unboxed:unboxed_annotation
225+
in
226+
Some {TranslateTypeExprFromTypes.dependencies = []; type_ = variant_typ}
170227
| _ -> None
171228
in
172229

@@ -197,24 +254,46 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
197254
in
198255
let export_type_body =
199256
match expected_translation_opt with
200-
| Some tr ->
201-
(* $GenTypeImport<Expected, Imported> *)
202-
ident GentypeImportHelper.name ~type_args:[tr.type_; imported_ident]
257+
| Some tr -> (
258+
let expected_for_wrapper =
259+
if GentypeImportHelper.should_inline_expected tr.type_ then tr.type_
260+
else
261+
name_with_module_path ^ "$ReScript"
262+
|> ident ~builtin:false
263+
~type_args:(type_vars |> List.map (fun s -> TypeVar s))
264+
in
265+
match import_exact_opt with
266+
| Some true ->
267+
ident GentypeImportHelper.strict_name
268+
~type_args:[imported_ident; expected_for_wrapper]
269+
| _ ->
270+
ident GentypeImportHelper.name
271+
~type_args:[expected_for_wrapper; imported_ident])
203272
| None -> imported_ident
204273
in
205274
typeName_
206275
|> create_export_type_from_type_declaration ~doc_string
207276
~annotation:GenType ~loc ~name_as:None ~opaque:(Some false)
208277
~type_:export_type_body ~type_env ~type_vars
209278
in
210-
[{CodeItem.import_types; export_from_type_declaration}]
279+
[
280+
{
281+
CodeItem.import_types;
282+
export_from_type_declaration;
283+
expected_type =
284+
(match expected_translation_opt with
285+
| Some tr -> Some tr.type_
286+
| None -> None);
287+
};
288+
]
211289
| (GeneralDeclarationFromTypes None | GeneralDeclaration None), None ->
212290
{
213291
CodeItem.import_types = [];
214292
export_from_type_declaration =
215293
type_name
216294
|> create_export_type_from_type_declaration ~doc_string ~annotation ~loc
217295
~name_as ~opaque:(Some true) ~type_:unknown ~type_env ~type_vars;
296+
expected_type = None;
218297
}
219298
|> return_type_declaration
220299
| GeneralDeclarationFromTypes (Some type_expr), None ->
@@ -270,6 +349,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
270349
type_name
271350
|> create_export_type_from_type_declaration ~doc_string ~annotation ~loc
272351
~name_as ~opaque ~type_ ~type_env ~type_vars;
352+
expected_type = None;
273353
}
274354
|> return_type_declaration
275355
| VariantDeclarationFromTypes constructor_declarations, None ->
@@ -348,7 +428,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver
348428
|> List.map (fun (_, _, _, import_types) -> import_types)
349429
|> List.concat
350430
in
351-
{CodeItem.export_from_type_declaration; import_types}
431+
{CodeItem.export_from_type_declaration; import_types; expected_type = None}
352432
|> return_type_declaration
353433
| NoDeclaration, None -> []
354434

‎compiler/gentype/Translation.ml‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -138,7 +138,10 @@ let translate_primitive ~config ~output_file_relative ~resolver ~type_env
138138
value_description.val_desc
139139
|> TranslateCoreType.translate_core_type ~config ~type_env
140140
in
141-
let attribute_import, attribute_renaming =
141+
let ( attribute_import,
142+
attribute_renaming,
143+
_import_exact_opt,
144+
_remote_export_name_opt ) =
142145
value_description.val_attributes |> Annotation.get_attribute_import_renaming
143146
in
144147
match (type_expr_translation.type_, attribute_import) with
@@ -205,6 +208,7 @@ let add_type_declarations_from_module_equations ~type_env (translation : t) =
205208
.annotation;
206209
};
207210
import_types = [];
211+
expected_type = None;
208212
}))
209213
|> List.concat
210214
in

‎lib/bs/build.ninja‎

Whitespace-only changes.

‎lib/rescript.lock‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
69167

‎packages/playground/src/App.res.js‎

Lines changed: 2 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/gentype_tests/genimport-single/package.json‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,7 @@
77
"typecheck": "tsc"
88
},
99
"dependencies": {
10+
"react-aria-components": "1.12.1",
1011
"rescript": "workspace:^"
1112
},
1213
"devDependencies": {

0 commit comments

Comments
 (0)