Skip to content

Commit 8106fe0

Browse files
zthzth
committed
rework a bit mor
1 parent 0c0c385 commit 8106fe0

12 files changed

+281
-52
lines changed

‎compiler/gentype/CodeItem.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ type import_value = {
1515
import_annotation: Annotation.import;
1616
type_: type_;
1717
value_name: string;
18+
export_binding: bool; (* when false, only emit local satisfies check, no TS export *)
1819
}
1920

2021
type export_value = {

‎compiler/gentype/EmitJs.ml‎

Lines changed: 76 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -143,7 +143,8 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name
143143
Log_.item "Code Item: %s\n"
144144
(code_item |> code_item_to_string ~config ~type_name_is_interface);
145145
match code_item with
146-
| ImportValue {as_path; import_annotation; type_; value_name} ->
146+
| ImportValue {as_path; import_annotation; type_; value_name; export_binding}
147+
->
147148
let import_path = import_annotation.import_path in
148149
let first_name_in_path, rest_of_path =
149150
match value_name = as_path with
@@ -163,8 +164,15 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name
163164
in
164165
(emitters, value_name_not_checked, env)
165166
in
166-
let type_ =
167+
(* Extract potential satisfies wrapper to drive custom emission. *)
168+
let satisfies_rescript_type_opt =
167169
match type_ with
170+
| Ident {builtin = _; name; type_args = [rescript_t; _]}
171+
when SatisfiesHelpers.is_helper_ident name -> Some rescript_t
172+
| _ -> None
173+
in
174+
let adjust_for_function_component t =
175+
match t with
168176
| Function
169177
({
170178
arg_types = [{a_type = Object (closed_flag, fields); a_name}];
@@ -217,44 +225,81 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name
217225
}
218226
in
219227
Function function_
220-
| _ -> type_)
221-
| _ -> type_
228+
| _ -> t)
229+
| _ -> t
230+
in
231+
let type_for_emit = adjust_for_function_component type_ in
232+
let value_name_type_checked =
233+
let base = value_name ^ "TypeChecked" in
234+
match export_binding with
235+
| false -> "_" ^ base
236+
| true -> base
222237
in
223-
let value_name_type_checked = value_name ^ "TypeChecked" in
224238
let emitters =
225-
imported_as_name ^ rest_of_path
226-
|> EmitType.emit_export_const ~config
227-
~comment:
228-
("In case of type error, check the type of '" ^ value_name
229-
^ "' in '"
230-
^ (file_name |> ModuleName.to_string)
231-
^ ".res'" ^ " and '"
232-
^ (import_path |> ImportPath.emit)
233-
^ "'.")
234-
~early:true ~emitters ~name:value_name_type_checked ~type_
235-
~type_name_is_interface
239+
match satisfies_rescript_type_opt with
240+
| Some rescript_type ->
241+
let rescript_type = adjust_for_function_component rescript_type in
242+
let expr = imported_as_name ^ rest_of_path in
243+
(* Non-exported const for the checked binding, emitted early for ordering. *)
244+
let comment =
245+
match export_binding with
246+
| false -> "Check imported TypeScript value conforms to ReScript type"
247+
| true -> ""
248+
in
249+
EmitType.emit_const_satisfies ~early:true ~emitters ~config
250+
~satisfies_type:rescript_type ~type_name_is_interface ~comment
251+
value_name_type_checked expr
252+
| None ->
253+
imported_as_name ^ rest_of_path
254+
|> EmitType.emit_export_const ~config
255+
~comment:
256+
("In case of type error, check the type of '" ^ value_name
257+
^ "' in '"
258+
^ (file_name |> ModuleName.to_string)
259+
^ ".res'" ^ " and '"
260+
^ (import_path |> ImportPath.emit)
261+
^ "'.")
262+
~early:true ~emitters ~name:value_name_type_checked ~type_:type_for_emit
263+
~type_name_is_interface
236264
in
237265
let value_name_not_default =
238266
match value_name = "default" with
239267
| true -> Runtime.default
240268
| false -> value_name
241269
in
242-
let emitters =
243-
value_name_type_checked
244-
|> EmitType.emit_type_cast ~config ~type_ ~type_name_is_interface
245-
|> EmitType.emit_export_const
246-
~comment:
247-
("Export '" ^ value_name_not_default
248-
^ "' early to allow circular import from the '.bs.js' file.")
249-
~config ~early:true ~emitters ~name:value_name_not_default
250-
~type_:unknown ~type_name_is_interface
251-
in
252-
let emitters =
253-
match value_name = "default" with
254-
| true -> EmitType.emit_export_default ~emitters value_name_not_default
255-
| false -> emitters
270+
let env, emitters =
271+
match export_binding with
272+
| false -> (env, emitters)
273+
| true ->
274+
let emitters =
275+
match satisfies_rescript_type_opt with
276+
| Some _ ->
277+
(* For satisfies, we can assign the typed binding directly without casts. *)
278+
EmitType.emit_export_const_assign_value ~early:true ~emitters ~config
279+
~name:value_name_not_default ~type_:type_for_emit
280+
~type_name_is_interface value_name_type_checked
281+
~comment:
282+
("Export '" ^ value_name_not_default
283+
^ "' early to allow circular import from the '.bs.js' file.")
284+
| None ->
285+
value_name_type_checked
286+
|> EmitType.emit_type_cast ~config ~type_:type_for_emit
287+
~type_name_is_interface
288+
|> EmitType.emit_export_const
289+
~comment:
290+
("Export '" ^ value_name_not_default
291+
^ "' early to allow circular import from the '.bs.js' file.")
292+
~config ~early:true ~emitters ~name:value_name_not_default
293+
~type_:unknown ~type_name_is_interface
294+
in
295+
let emitters =
296+
match value_name = "default" with
297+
| true -> EmitType.emit_export_default ~emitters value_name_not_default
298+
| false -> emitters
299+
in
300+
({env with imported_value_or_component = true}, emitters)
256301
in
257-
({env with imported_value_or_component = true}, emitters)
302+
(env, emitters)
258303
| ExportValue
259304
{doc_string; module_access_path; original_name; resolved_name; type_} ->
260305
let resolved_name_str = ResolvedName.to_string resolved_name in

‎compiler/gentype/EmitType.ml‎

Lines changed: 74 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -361,6 +361,57 @@ let emit_export_const ~early ?(comment = "") ~config
361361
| false -> Emitters.export)
362362
~emitters
363363

364+
let emit_export_const_satisfies ~early ?(comment = "") ~config
365+
?(doc_string = DocString.empty) ~emitters ~name ~satisfies_type
366+
~type_name_is_interface expr =
367+
let type_string =
368+
satisfies_type |> type_to_string ~config ~type_name_is_interface
369+
in
370+
(match comment = "" with
371+
| true -> comment
372+
| false -> "// " ^ comment ^ "\n")
373+
^ DocString.render doc_string
374+
^ "export const "
375+
^ name
376+
^ " = "
377+
^ expr
378+
^ " satisfies "
379+
^ type_string
380+
^ ";"
381+
|> (match early with
382+
| true -> Emitters.export_early
383+
| false -> Emitters.export)
384+
~emitters
385+
386+
let emit_const_satisfies ~early ~emitters ~config ~satisfies_type
387+
~type_name_is_interface ?(comment = "") name expr =
388+
let type_string =
389+
satisfies_type |> type_to_string ~config ~type_name_is_interface
390+
in
391+
((match comment = "" with
392+
| true -> ""
393+
| false -> "// " ^ comment ^ "\n")
394+
^ "const " ^ name ^ " = " ^ expr ^ " satisfies " ^ type_string ^ ";")
395+
|> (match early with
396+
| true -> Emitters.export_early
397+
| false -> Emitters.export)
398+
~emitters
399+
400+
let emit_export_const_assign ~early ?(comment = "") ~config
401+
?(doc_string = DocString.empty) ~emitters ~name ~type_
402+
~type_name_is_interface expr =
403+
let type_string = type_ |> type_to_string ~config ~type_name_is_interface in
404+
(match comment = "" with
405+
| true -> comment
406+
| false -> "// " ^ comment ^ "\n")
407+
^ DocString.render doc_string
408+
^ "export const " ^ name ^ ": " ^ type_string ^ " = " ^ expr
409+
^ ";" ^ "\n" ^ "// value-satisfies"
410+
|> (match early with
411+
| true -> Emitters.export_early
412+
| false -> Emitters.export)
413+
~emitters
414+
364415
let emit_export_default ~emitters name =
365416
"export default " ^ name ^ ";" |> Emitters.export ~emitters
366417

@@ -472,3 +523,26 @@ let emit_import_type_as ~emitters ~config ~type_name ~as_type_name
472523

473524
let emit_type_cast ~config ~type_ ~type_name_is_interface s =
474525
s ^ " as " ^ (type_ |> type_to_string ~config ~type_name_is_interface)
526+
527+
let rec type_to_string_for_value ~config ~type_name_is_interface type_ =
528+
match type_ with
529+
| Ident {builtin = _; name; type_args = res_t :: _}
530+
when SatisfiesHelpers.is_helper_ident name ->
531+
type_to_string_for_value ~config ~type_name_is_interface res_t
532+
| _ -> type_to_string ~config ~type_name_is_interface type_
533+
534+
let emit_export_const_assign_value ~early ?(comment = "") ~config
535+
?(doc_string = DocString.empty) ~emitters ~name ~type_
536+
~type_name_is_interface expr =
537+
let type_string =
538+
type_ |> type_to_string_for_value ~config ~type_name_is_interface
539+
in
540+
(match comment = "" with
541+
| true -> comment
542+
| false -> "// " ^ comment ^ "\n")
543+
^ DocString.render doc_string
544+
^ "export const " ^ name ^ ": " ^ type_string ^ " = " ^ expr ^ ";"
545+
|> (match early with
546+
| true -> Emitters.export_early
547+
| false -> Emitters.export)
548+
~emitters

‎compiler/gentype/SatisfiesHelpers.ml‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,13 +8,13 @@ let render_helper_ident ~rendered_name ~rendered_type_args
88
| [a1; a2] ->
99
let render_arg s = " " ^ s in
1010
rendered_name ^ "<\n" ^ render_arg a1 ^ ",\n" ^ render_arg a2 ^ "\n>"
11-
| _ -> rendered_name ^ EmitText.generics_string ~type_vars:rendered_type_args_default
11+
| _ ->
12+
rendered_name
13+
^ EmitText.generics_string ~type_vars:rendered_type_args_default
1214

1315
let emit_helper_alias ~emitters =
1416
let alias =
15-
"export type $RescriptTypeSatisfiesTypeScriptType<\n\
16-
RescriptType,\n\
17-
TypeScriptType extends RescriptType\n\
18-
> = TypeScriptType;"
17+
"export type $RescriptTypeSatisfiesTypeScriptType<RescriptType, \
18+
TypeScriptType extends RescriptType> = TypeScriptType;"
1919
in
2020
Emitters.export_early ~emitters alias

‎compiler/gentype/Translation.ml‎

Lines changed: 51 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -141,16 +141,63 @@ let translate_primitive ~config ~output_file_relative ~resolver ~type_env
141141
let attribute_import, attribute_renaming =
142142
value_description.val_attributes |> Annotation.get_attribute_import_renaming
143143
in
144-
match (type_expr_translation.type_, attribute_import) with
144+
let satisfies_attr =
145+
value_description.val_attributes |> Annotation.get_attribute_satisfies
146+
in
147+
(* Determine whether to export the imported value on the TS surface. *)
148+
let has_plain_gentype =
149+
Annotation.has_attribute Annotation.tag_is_gentype
150+
value_description.val_attributes
151+
in
152+
let has_gentype_import =
153+
Annotation.has_attribute Annotation.tag_is_gentype_import
154+
value_description.val_attributes
155+
in
156+
let export_binding = has_plain_gentype || has_gentype_import in
157+
(* Optionally wrap the type with the `satisfies` helper when present. *)
158+
let type_with_satisfies type_ =
159+
match
160+
value_description.val_attributes |> Annotation.get_attribute_satisfies
161+
with
162+
| None -> type_
163+
| Some (import_str, path) ->
164+
let import_path = ImportPath.from_string_unsafe import_str in
165+
let import_path_str = ImportPath.emit import_path in
166+
(* For values, reference the TS value type via `typeof import('...').x` *)
167+
let inline_import =
168+
let base = "typeof import(\"" ^ import_path_str ^ "\")" in
169+
match path with
170+
| [] -> base
171+
| _ -> base ^ "." ^ String.concat "." path
172+
in
173+
let ts_type = ident ~builtin:true inline_import in
174+
ident ~builtin:true ~type_args:[type_; ts_type]
175+
SatisfiesHelpers.helper_type_name
176+
in
177+
let effective_import_string =
178+
match (attribute_import, satisfies_attr) with
179+
| Some import_string, _ -> Some import_string
180+
| None, Some (import_string, _) -> Some import_string
181+
| None, None -> None
182+
in
183+
match (type_expr_translation.type_, effective_import_string) with
145184
| _, Some import_string ->
146185
let as_path =
147186
match attribute_renaming with
148187
| Some as_path -> as_path
149-
| None -> value_name
188+
| None -> (
189+
match satisfies_attr with
190+
| Some (_import_str, path) -> (
191+
match List.rev path with
192+
| last :: _ -> last
193+
| [] -> value_name)
194+
| None -> value_name)
150195
in
151196
let type_vars = type_expr_translation.type_ |> TypeVars.free in
152197
let type_ =
153-
type_expr_translation.type_ |> abstract_the_type_parameters ~type_vars
198+
type_expr_translation.type_
199+
|> abstract_the_type_parameters ~type_vars
200+
|> type_with_satisfies
154201
in
155202
{
156203
import_types =
@@ -164,6 +211,7 @@ let translate_primitive ~config ~output_file_relative ~resolver ~type_env
164211
import_annotation = import_string |> Annotation.import_from_string;
165212
type_;
166213
value_name;
214+
export_binding;
167215
};
168216
];
169217
type_declarations = [];

‎tests/gentype_tests/genimport-single/src/AriaComponents.gen.tsx‎

Lines changed: 28 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,12 @@
33
/* eslint-disable */
44
/* tslint:disable */
55

6-
export type $RescriptTypeSatisfiesTypeScriptType<
7-
RescriptType,
8-
TypeScriptType extends RescriptType
9-
> = TypeScriptType;
6+
import {useTableOptions as useTableOptionsNotChecked} from 'react-aria-components';
7+
8+
export type $RescriptTypeSatisfiesTypeScriptType<RescriptType, TypeScriptType extends RescriptType> = TypeScriptType;
9+
10+
// Check imported TypeScript value conforms to ReScript type
11+
const _useTableOptionsTypeChecked = useTableOptionsNotChecked satisfies () => tableOptionsContextValue;
1012

1113
export type groupRenderProps = $RescriptTypeSatisfiesTypeScriptType<
1214
{
@@ -18,3 +20,25 @@ export type groupRenderProps = $RescriptTypeSatisfiesTypeScriptType<
1820
},
1921
import("react-aria-components").GroupRenderProps
2022
>;
23+
24+
export type selectionBehavior = $RescriptTypeSatisfiesTypeScriptType<
25+
26+
"toggle"
27+
| "replace",
28+
import("react-stately").SelectionBehavior
29+
>;
30+
31+
export type selectionMode = $RescriptTypeSatisfiesTypeScriptType<
32+
33+
"none"
34+
| "single"
35+
| "multiple",
36+
import("react-stately").SelectionMode
37+
>;
38+
39+
export type tableOptionsContextValue = {
40+
readonly selectionMode: selectionMode;
41+
readonly selectionBehavior: (null | selectionBehavior);
42+
readonly disallowEmptySelection: boolean;
43+
readonly allowsDragging: boolean
44+
};

‎tests/gentype_tests/genimport-single/src/AriaComponents.res‎

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -6,3 +6,19 @@ type groupRenderProps = {
66
isDisabled: bool,
77
isInvalid: bool,
88
}
9+
10+
@gentype.satisfies(("react-stately", "SelectionBehavior"))
11+
type selectionBehavior = | @as("toggle") Toggle | @as("replace") Replace
12+
13+
@gentype.satisfies(("react-stately", "SelectionMode"))
14+
type selectionMode = | @as("none") None | @as("single") Single | @as("multiple") Multiple
15+
16+
type tableOptionsContextValue = {
17+
selectionMode: selectionMode,
18+
selectionBehavior: Null.t<selectionBehavior>,
19+
disallowEmptySelection: bool,
20+
allowsDragging: bool,
21+
}
22+
23+
@gentype.satisfies(("react-aria-components", "useTableOptions")) @module("react-aria-components")
24+
external useTableOptions: unit => tableOptionsContextValue = "useTableOptions"

‎tests/gentype_tests/genimport-single/src/GenTypeSatisfiesExpectedErrors.gen.tsx‎

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,10 +3,7 @@
33
/* eslint-disable */
44
/* tslint:disable */
55

6-
export type $RescriptTypeSatisfiesTypeScriptType<
7-
RescriptType,
8-
TypeScriptType extends RescriptType
9-
> = TypeScriptType;
6+
export type $RescriptTypeSatisfiesTypeScriptType<RescriptType, TypeScriptType extends RescriptType> = TypeScriptType;
107

118
import * as GenTypeSatisfiesExpectedErrorsJS from './GenTypeSatisfiesExpectedErrors.res.js';
129

0 commit comments

Comments
 (0)