Skip to content

Commit ad6f154

Browse files
BushuoBushuo
committed
feat: handle absolute paths in gentype
1 parent 49bcc32 commit ad6f154

File tree

2 files changed

+83
-60
lines changed

2 files changed

+83
-60
lines changed

‎compiler/gentype/GenTypeMain.ml

Lines changed: 54 additions & 55 deletions
Original file line numberDiff line numberDiff line change
@@ -90,74 +90,73 @@ 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 Annotation.tag_is_gentype_ignore_interface
100+
<> None
101+
then ignore_interface := true;
102+
attributes
103+
|> Annotation.get_attribute_payload Annotation.tag_is_one_of_the_gentype_annotations
104+
<> None
105+
in
106+
let has_gentype_annotations =
107+
input_cmt |> cmt_check_annotations ~check_annotation
108+
in
109+
if is_interface then
110+
let cmt_file_impl =
111+
(cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt"
112+
in
113+
let input_cmt_impl = read_cmt cmt_file_impl in
114+
let has_gentype_annotations_impl =
115+
input_cmt_impl
116+
|> cmt_check_annotations ~check_annotation:(fun ~loc attributes ->
117+
if attributes |> check_annotation ~loc then (
118+
if not !ignore_interface then (
119+
Log_.Color.setup ();
120+
Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
121+
Format.fprintf ppf
122+
"Annotation is ignored as there's a .rei file"));
123+
true)
124+
else false)
125+
in
126+
( (match !ignore_interface with
127+
| true -> input_cmt_impl
128+
| false -> input_cmt),
129+
match !ignore_interface with
130+
| true -> has_gentype_annotations_impl
131+
| false -> has_gentype_annotations )
132+
else (input_cmt, has_gentype_annotations)
133+
93134
let process_cmt_file cmt =
94135
let config = Paths.read_config ~namespace:(cmt |> Paths.find_name_space) in
95136
if !Debug.basic then Log_.item "Cmt %s\n" cmt;
96137
let cmt_file = cmt |> Paths.get_cmt_file in
97138
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
100139
let file_name = cmt |> Paths.get_module_name in
101140
let is_interface = Filename.check_suffix cmt_file ".cmti" in
141+
let input_cmt, has_gentype_annotations = read_input_cmt is_interface cmt_file in
142+
let source_file =
143+
match input_cmt.cmt_annots |> FindSourceFile.cmt with
144+
| Some source_file -> source_file
145+
| None -> (
146+
(file_name |> ModuleName.to_string)
147+
^
148+
match is_interface with
149+
| true -> ".resi"
150+
| false -> ".res")
151+
in
152+
let output_file = source_file |> Paths.get_output_file ~config in
153+
let output_file_relative = source_file |> Paths.get_output_file_relative ~config in
102154
let resolver =
103155
ModuleResolver.create_lazy_resolver ~config
104156
~extensions:[".res"; ".shim.ts"] ~exclude_file:(fun fname ->
105157
fname = "React.res" || fname = "ReasonReact.res")
106158
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 .rei 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
150159
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
161160
input_cmt
162161
|> translate_c_m_t ~config ~output_file_relative ~resolver
163162
|> emit_translation ~config ~file_name ~output_file ~output_file_relative

‎compiler/gentype/Paths.ml

Lines changed: 29 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -29,17 +29,41 @@ 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_project_root_from_absolute_path ~(config: Config.t) source_path =
33+
let i = String.length config.project_root + 1 in
34+
let n = String.length source_path - i in
35+
(String.sub source_path i n [@doesNotRaise])
3436

35-
let get_output_file ~(config : Config.t) cmt =
36-
Filename.concat config.project_root (get_output_file_relative ~config cmt)
37+
let get_output_file_relative ~config source_path =
38+
if Filename.is_relative source_path then
39+
(source_path |> handle_namespace) ^ ModuleExtension.ts_input_file_suffix ~config
40+
else
41+
let relative_path =
42+
remove_project_root_from_absolute_path ~config source_path
43+
in
44+
(relative_path |> handle_namespace) ^ ModuleExtension.ts_input_file_suffix ~config
45+
46+
let get_output_file ~(config : Config.t) sourcePath =
47+
if Filename.is_relative sourcePath then
48+
(* assuming a relative path from the project root *)
49+
Filename.concat config.project_root
50+
(get_output_file_relative ~config sourcePath)
51+
else
52+
(* we want to place the output beside the source file *)
53+
let relative_path =
54+
remove_project_root_from_absolute_path ~config sourcePath
55+
in
56+
Filename.concat config.project_root
57+
(get_output_file_relative ~config relative_path)
3758

3859
let get_module_name cmt =
3960
cmt |> handle_namespace |> Filename.basename |> ModuleName.from_string_unsafe
4061

4162
let get_cmt_file cmt =
42-
let path_cmt = Filename.concat (Sys.getcwd ()) cmt in
63+
let path_cmt =
64+
if Filename.is_relative cmt then Filename.concat (Sys.getcwd ()) cmt
65+
else cmt
66+
in
4367
let cmt_file =
4468
if Filename.check_suffix path_cmt ".cmt" then
4569
let path_cmt_lower_case =

0 commit comments

Comments
 (0)