Skip to content

Commit 176f02d

Browse files
BushuoBushuo
authored
v11 backport of #7104 (#7111)
* 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 * make find source file return only absolute paths * refactor: cleanup getOutputFile and getOutputFileRelative * chore: update changelog
1 parent 6de936a commit 176f02d

File tree

6 files changed

+106
-66
lines changed

6 files changed

+106
-66
lines changed

‎CHANGELOG.md

+1
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
1313
# 11.1.5 (Unreleased)
1414

15+
- Handle absolute file paths in gentype https://github.com/rescript-lang/rescript-compiler/pull/7111
1516
- Deprecate JSX 3 https://github.com/rescript-lang/rescript-compiler/pull/7042
1617
- Deprecate js_cast.res https://github.com/rescript-lang/rescript-compiler/pull/7074
1718
- Deprecate top-level `"suffix"` option in `rescript.json`. https://github.com/rescript-lang/rescript-compiler/pull/7056

‎jscomp/gentype/FindSourceFile.ml

+11-2
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

‎jscomp/gentype/FindSourceFile.mli

+8
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+
*)

‎jscomp/gentype/GenTypeConfig.ml

+5-4
Original file line numberDiff line numberDiff line change
@@ -234,6 +234,7 @@ let readConfig ~getConfigFile ~namespace =
234234
sources;
235235
}
236236
in
237+
let defaultConfig = {default with projectRoot; bsbProjectRoot} in
237238
match getConfigFile ~projectRoot with
238239
| Some bsConfigFile -> (
239240
try
@@ -242,7 +243,7 @@ let readConfig ~getConfigFile ~namespace =
242243
| Obj {map = bsconf} -> (
243244
match bsconf |> getOpt "gentypeconfig" with
244245
| Some (Obj {map = gtconf}) -> parseConfig ~bsconf ~gtconf
245-
| _ -> default)
246-
| _ -> default
247-
with _ -> default)
248-
| None -> default
246+
| _ -> defaultConfig)
247+
| _ -> defaultConfig
248+
with _ -> defaultConfig)
249+
| None -> defaultConfig

‎jscomp/gentype/GenTypeMain.ml

+56-55
Original file line numberDiff line numberDiff line change
@@ -90,74 +90,75 @@ let readCmt cmtFile =
9090
Log_.item "Try to clean and rebuild.\n\n";
9191
assert false
9292

93+
let readInputCmt isInterface cmtFile =
94+
let inputCMT = readCmt cmtFile in
95+
let ignoreInterface = ref false in
96+
let checkAnnotation ~loc:_ attributes =
97+
if
98+
attributes
99+
|> Annotation.getAttributePayload Annotation.tagIsGenTypeIgnoreInterface
100+
<> None
101+
then ignoreInterface := true;
102+
attributes
103+
|> Annotation.getAttributePayload Annotation.tagIsOneOfTheGenTypeAnnotations
104+
<> None
105+
in
106+
let hasGenTypeAnnotations =
107+
inputCMT |> cmtCheckAnnotations ~checkAnnotation
108+
in
109+
if isInterface then
110+
let cmtFileImpl =
111+
(cmtFile |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt"
112+
in
113+
let inputCMTImpl = readCmt cmtFileImpl in
114+
let hasGenTypeAnnotationsImpl =
115+
inputCMTImpl
116+
|> cmtCheckAnnotations ~checkAnnotation:(fun ~loc attributes ->
117+
if attributes |> checkAnnotation ~loc then (
118+
if not !ignoreInterface 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 !ignoreInterface with
127+
| true -> inputCMTImpl
128+
| false -> inputCMT),
129+
match !ignoreInterface with
130+
| true -> hasGenTypeAnnotationsImpl
131+
| false -> hasGenTypeAnnotations )
132+
else (inputCMT, hasGenTypeAnnotations)
133+
93134
let processCmtFile cmt =
94135
let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in
95136
if !Debug.basic then Log_.item "Cmt %s\n" cmt;
96137
let cmtFile = cmt |> Paths.getCmtFile in
97138
if cmtFile <> "" then
98-
let outputFile = cmt |> Paths.getOutputFile ~config in
99-
let outputFileRelative = cmt |> Paths.getOutputFileRelative ~config in
100139
let fileName = cmt |> Paths.getModuleName in
101140
let isInterface = Filename.check_suffix cmtFile ".cmti" in
141+
let inputCMT, hasGenTypeAnnotations = readInputCmt isInterface cmtFile in
142+
let sourceFile =
143+
match inputCMT.cmt_annots |> FindSourceFile.cmt with
144+
| Some sourceFile -> sourceFile
145+
| None -> (
146+
(fileName |> ModuleName.toString)
147+
^
148+
match isInterface with
149+
| true -> ".resi"
150+
| false -> ".res")
151+
in
152+
let outputFile = sourceFile |> Paths.getOutputFile ~config in
153+
let outputFileRelative =
154+
sourceFile |> Paths.getOutputFileRelative ~config
155+
in
102156
let resolver =
103157
ModuleResolver.createLazyResolver ~config ~extensions:[".res"; ".shim.ts"]
104158
~excludeFile:(fun fname ->
105159
fname = "React.res" || fname = "ReasonReact.res")
106160
in
107-
let inputCMT, hasGenTypeAnnotations =
108-
let inputCMT = readCmt cmtFile in
109-
let ignoreInterface = ref false in
110-
let checkAnnotation ~loc:_ attributes =
111-
if
112-
attributes
113-
|> Annotation.getAttributePayload
114-
Annotation.tagIsGenTypeIgnoreInterface
115-
<> None
116-
then ignoreInterface := true;
117-
attributes
118-
|> Annotation.getAttributePayload
119-
Annotation.tagIsOneOfTheGenTypeAnnotations
120-
<> None
121-
in
122-
let hasGenTypeAnnotations =
123-
inputCMT |> cmtCheckAnnotations ~checkAnnotation
124-
in
125-
if isInterface then
126-
let cmtFileImpl =
127-
(cmtFile |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt"
128-
in
129-
let inputCMTImpl = readCmt cmtFileImpl in
130-
let hasGenTypeAnnotationsImpl =
131-
inputCMTImpl
132-
|> cmtCheckAnnotations ~checkAnnotation:(fun ~loc attributes ->
133-
if attributes |> checkAnnotation ~loc then (
134-
if not !ignoreInterface 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 !ignoreInterface with
143-
| true -> inputCMTImpl
144-
| false -> inputCMT),
145-
match !ignoreInterface with
146-
| true -> hasGenTypeAnnotationsImpl
147-
| false -> hasGenTypeAnnotations )
148-
else (inputCMT, hasGenTypeAnnotations)
149-
in
150161
if hasGenTypeAnnotations then
151-
let sourceFile =
152-
match inputCMT.cmt_annots |> FindSourceFile.cmt with
153-
| Some sourceFile -> sourceFile
154-
| None -> (
155-
(fileName |> ModuleName.toString)
156-
^
157-
match isInterface with
158-
| true -> ".resi"
159-
| false -> ".res")
160-
in
161162
inputCMT
162163
|> translateCMT ~config ~outputFileRelative ~resolver
163164
|> emitTranslation ~config ~fileName ~outputFile ~outputFileRelative

‎jscomp/gentype/Paths.ml

+25-5
Original file line numberDiff line numberDiff line change
@@ -28,17 +28,37 @@ let findNameSpace cmt =
2828
cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise])
2929
|> keepAfterDash
3030

31-
let getOutputFileRelative ~config cmt =
32-
(cmt |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config
31+
let removePathPrefix ~prefix path =
32+
let normalizedPrefix = Filename.concat prefix "" in
33+
let prefixLen = String.length normalizedPrefix in
34+
let pathLen = String.length path in
35+
let isPrefix =
36+
prefixLen <= pathLen
37+
&& (String.sub path 0 prefixLen [@doesNotRaise]) = normalizedPrefix
38+
in
39+
if isPrefix then
40+
String.sub path prefixLen (pathLen - prefixLen) [@doesNotRaise]
41+
else path
42+
43+
let appendSuffix ~config sourcePath =
44+
(sourcePath |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config
3345

34-
let getOutputFile ~(config : Config.t) cmt =
35-
Filename.concat config.projectRoot (getOutputFileRelative ~config cmt)
46+
let getOutputFileRelative ~(config : Config.t) path =
47+
let relativePath = removePathPrefix ~prefix:config.projectRoot path in
48+
appendSuffix ~config relativePath
49+
50+
let getOutputFile ~(config : Config.t) absoluteSourcePath =
51+
let relativeOutputPath = getOutputFileRelative ~config absoluteSourcePath in
52+
Filename.concat config.projectRoot relativeOutputPath
3653

3754
let getModuleName cmt =
3855
cmt |> handleNamespace |> Filename.basename |> ModuleName.fromStringUnsafe
3956

4057
let getCmtFile cmt =
41-
let pathCmt = Filename.concat (Sys.getcwd ()) cmt in
58+
let pathCmt =
59+
if Filename.is_relative cmt then Filename.concat (Sys.getcwd ()) cmt
60+
else cmt
61+
in
4262
let cmtFile =
4363
if Filename.check_suffix pathCmt ".cmt" then
4464
let pathCmtLowerCase =

0 commit comments

Comments
 (0)