Skip to content

Commit 47870d0

Browse files
BushuoBushuo
authored
Handle absolute paths in typegen (#7104)
* refactor: extract fun from process_cmt_file * refactor: read the .cmt earlier * feat: handle paths via source_file instead of cmt_file * add project root to default config * refactor: extract funs to remove duplication * fix: consider file seperators * fix: please static checker * chore: update changelog * make find source file return only absolute paths * refactor: cleanup get_output_file and get_output_file_relative
1 parent 6d9df0f commit 47870d0

File tree

6 files changed

+114
-67
lines changed

6 files changed

+114
-67
lines changed

‎CHANGELOG.md

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,9 +22,10 @@
2222

2323
- Use FORCE_COLOR environmental variable to force colorized output https://github.com/rescript-lang/rescript-compiler/pull/7033
2424
- Allow spreads of variants in patterns (`| ...someVariant as v => `) when the variant spread is a subtype of the variant matched on. https://github.com/rescript-lang/rescript-compiler/pull/6721
25-
- Fix the issue where dynamic imports are not working for function-defined externals. https://github.com/rescript-lang/rescript-compiler/pull/7060
25+
- Fix the issue where dynamic imports are not working for function-defined externals. https://github.com/rescript-lang/rescript-compiler/pull/7060
2626
- Allow pattern matching on dicts. `switch someDict { | dict{"one": 1} => Js.log("one is one") }`. https://github.com/rescript-lang/rescript-compiler/pull/7059
2727
- "ReScript Core" standard library is now included in the `rescript` npm package. https://github.com/rescript-lang/rescript-compiler/pull/7108
28+
- Handle absolute filepaths in gentype. https://github.com/rescript-lang/rescript-compiler/pull/7104
2829

2930
#### :bug: Bug fix
3031

‎compiler/gentype/FindSourceFile.ml

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -14,8 +14,17 @@ let rec implementation items =
1414
| false -> Some str_loc.loc_start.pos_fname)
1515
| [] -> None
1616

17+
let transform_to_absolute_path (path : string option) =
18+
let transform path =
19+
if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path
20+
else path
21+
in
22+
Option.map transform path
23+
1724
let cmt cmt_annots =
1825
match cmt_annots with
19-
| Cmt_format.Interface signature -> interface signature.sig_items
20-
| Implementation structure -> implementation structure.str_items
26+
| Cmt_format.Interface signature ->
27+
transform_to_absolute_path (interface signature.sig_items)
28+
| Implementation structure ->
29+
transform_to_absolute_path (implementation structure.str_items)
2130
| _ -> None

‎compiler/gentype/FindSourceFile.mli

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
val cmt : Cmt_format.binary_annots -> string option
2+
(**
3+
[cmt annots] given [Cmt_format.binary_annots] it returns an absolute source file path
4+
if the file exists, otherwise it returns None.
5+
6+
@param annots The binary annotations to be processed.
7+
@return An optional absolute path to the source file.
8+
*)

‎compiler/gentype/GenTypeConfig.ml

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -239,6 +239,7 @@ let read_config ~get_config_file ~namespace =
239239
sources;
240240
}
241241
in
242+
let default_config = {default with project_root; bsb_project_root} in
242243
match get_config_file ~project_root with
243244
| Some bs_config_file -> (
244245
try
@@ -247,7 +248,7 @@ let read_config ~get_config_file ~namespace =
247248
| Obj {map = bsconf} -> (
248249
match bsconf |> get_opt "gentypeconfig" with
249250
| Some (Obj {map = gtconf}) -> parse_config ~bsconf ~gtconf
250-
| _ -> default)
251-
| _ -> default
252-
with _ -> default)
253-
| None -> default
251+
| _ -> default_config)
252+
| _ -> default_config
253+
with _ -> default_config)
254+
| None -> default_config

‎compiler/gentype/GenTypeMain.ml

Lines changed: 60 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -90,74 +90,79 @@ let read_cmt cmt_file =
9090
Log_.item "Try to clean and rebuild.\n\n";
9191
assert false
9292

93+
let read_input_cmt is_interface cmt_file =
94+
let input_cmt = read_cmt cmt_file in
95+
let ignore_interface = ref false in
96+
let check_annotation ~loc:_ attributes =
97+
if
98+
attributes
99+
|> Annotation.get_attribute_payload
100+
Annotation.tag_is_gentype_ignore_interface
101+
<> None
102+
then ignore_interface := true;
103+
attributes
104+
|> Annotation.get_attribute_payload
105+
Annotation.tag_is_one_of_the_gentype_annotations
106+
<> None
107+
in
108+
let has_gentype_annotations =
109+
input_cmt |> cmt_check_annotations ~check_annotation
110+
in
111+
if is_interface then
112+
let cmt_file_impl =
113+
(cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt"
114+
in
115+
let input_cmt_impl = read_cmt cmt_file_impl in
116+
let has_gentype_annotations_impl =
117+
input_cmt_impl
118+
|> cmt_check_annotations ~check_annotation:(fun ~loc attributes ->
119+
if attributes |> check_annotation ~loc then (
120+
if not !ignore_interface then (
121+
Log_.Color.setup ();
122+
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
123+
Format.fprintf ppf
124+
"Annotation is ignored as there's a .resi file"));
125+
true)
126+
else false)
127+
in
128+
( (match !ignore_interface with
129+
| true -> input_cmt_impl
130+
| false -> input_cmt),
131+
match !ignore_interface with
132+
| true -> has_gentype_annotations_impl
133+
| false -> has_gentype_annotations )
134+
else (input_cmt, has_gentype_annotations)
135+
93136
let process_cmt_file cmt =
94137
let config = Paths.read_config ~namespace:(cmt |> Paths.find_name_space) in
95138
if !Debug.basic then Log_.item "Cmt %s\n" cmt;
96139
let cmt_file = cmt |> Paths.get_cmt_file in
97140
if cmt_file <> "" then
98-
let output_file = cmt |> Paths.get_output_file ~config in
99-
let output_file_relative = cmt |> Paths.get_output_file_relative ~config in
100141
let file_name = cmt |> Paths.get_module_name in
101142
let is_interface = Filename.check_suffix cmt_file ".cmti" in
143+
let input_cmt, has_gentype_annotations =
144+
read_input_cmt is_interface cmt_file
145+
in
146+
let source_file =
147+
match input_cmt.cmt_annots |> FindSourceFile.cmt with
148+
| Some source_file -> source_file
149+
| None -> (
150+
(file_name |> ModuleName.to_string)
151+
^
152+
match is_interface with
153+
| true -> ".resi"
154+
| false -> ".res")
155+
in
156+
let output_file = source_file |> Paths.get_output_file ~config in
157+
let output_file_relative =
158+
source_file |> Paths.get_output_file_relative ~config
159+
in
102160
let resolver =
103161
ModuleResolver.create_lazy_resolver ~config
104162
~extensions:[".res"; ".shim.ts"] ~exclude_file:(fun fname ->
105163
fname = "React.res" || fname = "ReasonReact.res")
106164
in
107-
let input_cmt, has_gentype_annotations =
108-
let input_cmt = read_cmt cmt_file in
109-
let ignore_interface = ref false in
110-
let check_annotation ~loc:_ attributes =
111-
if
112-
attributes
113-
|> Annotation.get_attribute_payload
114-
Annotation.tag_is_gentype_ignore_interface
115-
<> None
116-
then ignore_interface := true;
117-
attributes
118-
|> Annotation.get_attribute_payload
119-
Annotation.tag_is_one_of_the_gentype_annotations
120-
<> None
121-
in
122-
let has_gentype_annotations =
123-
input_cmt |> cmt_check_annotations ~check_annotation
124-
in
125-
if is_interface then
126-
let cmt_file_impl =
127-
(cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt"
128-
in
129-
let input_cmt_impl = read_cmt cmt_file_impl in
130-
let has_gentype_annotations_impl =
131-
input_cmt_impl
132-
|> cmt_check_annotations ~check_annotation:(fun ~loc attributes ->
133-
if attributes |> check_annotation ~loc then (
134-
if not !ignore_interface then (
135-
Log_.Color.setup ();
136-
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
137-
Format.fprintf ppf
138-
"Annotation is ignored as there's a .resi file"));
139-
true)
140-
else false)
141-
in
142-
( (match !ignore_interface with
143-
| true -> input_cmt_impl
144-
| false -> input_cmt),
145-
match !ignore_interface with
146-
| true -> has_gentype_annotations_impl
147-
| false -> has_gentype_annotations )
148-
else (input_cmt, has_gentype_annotations)
149-
in
150165
if has_gentype_annotations then
151-
let source_file =
152-
match input_cmt.cmt_annots |> FindSourceFile.cmt with
153-
| Some source_file -> source_file
154-
| None -> (
155-
(file_name |> ModuleName.to_string)
156-
^
157-
match is_interface with
158-
| true -> ".resi"
159-
| false -> ".res")
160-
in
161166
input_cmt
162167
|> translate_c_m_t ~config ~output_file_relative ~resolver
163168
|> emit_translation ~config ~file_name ~output_file ~output_file_relative

‎compiler/gentype/Paths.ml

Lines changed: 28 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -29,17 +29,40 @@ let find_name_space cmt =
2929
cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise])
3030
|> keep_after_dash
3131

32-
let get_output_file_relative ~config cmt =
33-
(cmt |> handle_namespace) ^ ModuleExtension.ts_input_file_suffix ~config
32+
let remove_path_prefix ~prefix path =
33+
let normalized_prefix = Filename.concat prefix "" in
34+
let prefix_len = String.length normalized_prefix in
35+
let path_len = String.length path in
36+
let is_prefix =
37+
prefix_len <= path_len
38+
&& (String.sub path 0 prefix_len [@doesNotRaise]) = normalized_prefix
39+
in
40+
if is_prefix then
41+
String.sub path prefix_len (path_len - prefix_len) [@doesNotRaise]
42+
else path
43+
44+
let append_suffix ~config source_path =
45+
(source_path |> handle_namespace)
46+
^ ModuleExtension.ts_input_file_suffix ~config
3447

35-
let get_output_file ~(config : Config.t) cmt =
36-
Filename.concat config.project_root (get_output_file_relative ~config cmt)
48+
let get_output_file_relative ~(config : Config.t) source_path =
49+
let relativePath =
50+
remove_path_prefix ~prefix:config.project_root source_path
51+
in
52+
append_suffix ~config relativePath
53+
54+
let get_output_file ~(config : Config.t) source_path =
55+
let relative_output_path = get_output_file_relative ~config source_path in
56+
Filename.concat config.project_root relative_output_path
3757

3858
let get_module_name cmt =
3959
cmt |> handle_namespace |> Filename.basename |> ModuleName.from_string_unsafe
4060

4161
let get_cmt_file cmt =
42-
let path_cmt = Filename.concat (Sys.getcwd ()) cmt in
62+
let path_cmt =
63+
if Filename.is_relative cmt then Filename.concat (Sys.getcwd ()) cmt
64+
else cmt
65+
in
4366
let cmt_file =
4467
if Filename.check_suffix path_cmt ".cmt" then
4568
let path_cmt_lower_case =

0 commit comments

Comments
 (0)