From bac81a6b4ea2ab49439b1561d9821461d6ea1d23 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Thu, 17 Oct 2024 19:58:00 +0200 Subject: [PATCH 01/10] refactor: extract fun from process_cmt_file --- jscomp/gentype/GenTypeMain.ml | 85 +++++++++++++++++------------------ 1 file changed, 42 insertions(+), 43 deletions(-) diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index 5b733f1e57..2018de0c2a 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -90,6 +90,47 @@ let readCmt cmtFile = Log_.item "Try to clean and rebuild.\n\n"; assert false +let readInputCmt isInterface cmtFile = + let inputCMT = readCmt cmtFile in + let ignoreInterface = ref false in + let checkAnnotation ~loc:_ attributes = + if + attributes + |> Annotation.getAttributePayload Annotation.tagIsGenTypeIgnoreInterface + <> None + then ignoreInterface := true; + attributes + |> Annotation.getAttributePayload Annotation.tagIsOneOfTheGenTypeAnnotations + <> None + in + let hasGenTypeAnnotations = + inputCMT |> cmtCheckAnnotations ~checkAnnotation + in + if isInterface then + let cmtFileImpl = + (cmtFile |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" + in + let inputCMTImpl = readCmt cmtFileImpl in + let hasGenTypeAnnotationsImpl = + inputCMTImpl + |> cmtCheckAnnotations ~checkAnnotation:(fun ~loc attributes -> + if attributes |> checkAnnotation ~loc then ( + if not !ignoreInterface then ( + Log_.Color.setup (); + Log_.info ~loc ~name:"Warning genType" (fun ppf () -> + Format.fprintf ppf + "Annotation is ignored as there's a .rei file")); + true) + else false) + in + ( (match !ignoreInterface with + | true -> inputCMTImpl + | false -> inputCMT), + match !ignoreInterface with + | true -> hasGenTypeAnnotationsImpl + | false -> hasGenTypeAnnotations ) + else (inputCMT, hasGenTypeAnnotations) + let processCmtFile cmt = let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in if !Debug.basic then Log_.item "Cmt %s\n" cmt; @@ -104,49 +145,7 @@ let processCmtFile cmt = ~excludeFile:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in - let inputCMT, hasGenTypeAnnotations = - let inputCMT = readCmt cmtFile in - let ignoreInterface = ref false in - let checkAnnotation ~loc:_ attributes = - if - attributes - |> Annotation.getAttributePayload - Annotation.tagIsGenTypeIgnoreInterface - <> None - then ignoreInterface := true; - attributes - |> Annotation.getAttributePayload - Annotation.tagIsOneOfTheGenTypeAnnotations - <> None - in - let hasGenTypeAnnotations = - inputCMT |> cmtCheckAnnotations ~checkAnnotation - in - if isInterface then - let cmtFileImpl = - (cmtFile |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" - in - let inputCMTImpl = readCmt cmtFileImpl in - let hasGenTypeAnnotationsImpl = - inputCMTImpl - |> cmtCheckAnnotations ~checkAnnotation:(fun ~loc attributes -> - if attributes |> checkAnnotation ~loc then ( - if not !ignoreInterface then ( - Log_.Color.setup (); - Log_.info ~loc ~name:"Warning genType" (fun ppf () -> - Format.fprintf ppf - "Annotation is ignored as there's a .rei file")); - true) - else false) - in - ( (match !ignoreInterface with - | true -> inputCMTImpl - | false -> inputCMT), - match !ignoreInterface with - | true -> hasGenTypeAnnotationsImpl - | false -> hasGenTypeAnnotations ) - else (inputCMT, hasGenTypeAnnotations) - in + let inputCMT, hasGenTypeAnnotations = readInputCmt isInterface cmtFile in if hasGenTypeAnnotations then let sourceFile = match inputCMT.cmt_annots |> FindSourceFile.cmt with From 5019280b177f28c27eb47e0afb3b8aef39c10baf Mon Sep 17 00:00:00 2001 From: Bushuo Date: Thu, 17 Oct 2024 20:06:14 +0200 Subject: [PATCH 02/10] refactor: read the .cmt earlier --- jscomp/gentype/GenTypeMain.ml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index 2018de0c2a..4cd0761e1a 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -140,23 +140,23 @@ let processCmtFile cmt = let outputFileRelative = cmt |> Paths.getOutputFileRelative ~config in let fileName = cmt |> Paths.getModuleName in let isInterface = Filename.check_suffix cmtFile ".cmti" in + let inputCMT, hasGenTypeAnnotations = readInputCmt isInterface cmtFile in + let sourceFile = + match inputCMT.cmt_annots |> FindSourceFile.cmt with + | Some sourceFile -> sourceFile + | None -> ( + (fileName |> ModuleName.toString) + ^ + match isInterface with + | true -> ".resi" + | false -> ".res") + in let resolver = ModuleResolver.createLazyResolver ~config ~extensions:[".res"; ".shim.ts"] ~excludeFile:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in - let inputCMT, hasGenTypeAnnotations = readInputCmt isInterface cmtFile in if hasGenTypeAnnotations then - let sourceFile = - match inputCMT.cmt_annots |> FindSourceFile.cmt with - | Some sourceFile -> sourceFile - | None -> ( - (fileName |> ModuleName.toString) - ^ - match isInterface with - | true -> ".resi" - | false -> ".res") - in inputCMT |> translateCMT ~config ~outputFileRelative ~resolver |> emitTranslation ~config ~fileName ~outputFile ~outputFileRelative From b712db06fd1094f024949400cc72fbef8c58e425 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Thu, 17 Oct 2024 20:10:46 +0200 Subject: [PATCH 03/10] feat: handle paths via source_file instead of cmt_file --- jscomp/gentype/GenTypeMain.ml | 6 ++++-- jscomp/gentype/Paths.ml | 35 ++++++++++++++++++++++++++++++----- 2 files changed, 34 insertions(+), 7 deletions(-) diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index 4cd0761e1a..ff75f56fd1 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -136,8 +136,6 @@ let processCmtFile cmt = if !Debug.basic then Log_.item "Cmt %s\n" cmt; let cmtFile = cmt |> Paths.getCmtFile in if cmtFile <> "" then - let outputFile = cmt |> Paths.getOutputFile ~config in - let outputFileRelative = cmt |> Paths.getOutputFileRelative ~config in let fileName = cmt |> Paths.getModuleName in let isInterface = Filename.check_suffix cmtFile ".cmti" in let inputCMT, hasGenTypeAnnotations = readInputCmt isInterface cmtFile in @@ -151,6 +149,10 @@ let processCmtFile cmt = | true -> ".resi" | false -> ".res") in + let outputFile = sourceFile |> Paths.getOutputFile ~config in + let outputFileRelative = + sourceFile |> Paths.getOutputFileRelative ~config + in let resolver = ModuleResolver.createLazyResolver ~config ~extensions:[".res"; ".shim.ts"] ~excludeFile:(fun fname -> diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index ed95905268..9fc30569cf 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -28,17 +28,42 @@ let findNameSpace cmt = cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise]) |> keepAfterDash -let getOutputFileRelative ~config cmt = - (cmt |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config +let remove_project_root_from_absolute_path ~(config : Config.t) source_path = + let i = String.length config.projectRoot + 1 in + let n = String.length source_path - i in + (String.sub source_path i n [@doesNotRaise]) -let getOutputFile ~(config : Config.t) cmt = - Filename.concat config.projectRoot (getOutputFileRelative ~config cmt) +let getOutputFileRelative ~config source_path = + if Filename.is_relative source_path then + (source_path |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config + else + let relative_path = + remove_project_root_from_absolute_path ~config source_path + in + (relative_path |> handleNamespace) + ^ ModuleExtension.tsInputFileSuffix ~config + +let getOutputFile ~(config : Config.t) sourcePath = + if Filename.is_relative sourcePath then + (* assuming a relative path from the project root *) + Filename.concat config.projectRoot + (getOutputFileRelative ~config sourcePath) + else + (* we want to place the output beside the source file *) + let relative_path = + remove_project_root_from_absolute_path ~config sourcePath + in + Filename.concat config.projectRoot + (getOutputFileRelative ~config relative_path) let getModuleName cmt = cmt |> handleNamespace |> Filename.basename |> ModuleName.fromStringUnsafe let getCmtFile cmt = - let pathCmt = Filename.concat (Sys.getcwd ()) cmt in + let pathCmt = + if Filename.is_relative cmt then Filename.concat (Sys.getcwd ()) cmt + else cmt + in let cmtFile = if Filename.check_suffix pathCmt ".cmt" then let pathCmtLowerCase = From e32dfb5dd02d182b24f759335cb5ed0b3470d174 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Thu, 17 Oct 2024 14:26:36 +0200 Subject: [PATCH 04/10] add project root to default config --- jscomp/gentype/GenTypeConfig.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/jscomp/gentype/GenTypeConfig.ml b/jscomp/gentype/GenTypeConfig.ml index 9e5ec193c8..73847c8365 100644 --- a/jscomp/gentype/GenTypeConfig.ml +++ b/jscomp/gentype/GenTypeConfig.ml @@ -234,6 +234,7 @@ let readConfig ~getConfigFile ~namespace = sources; } in + let defaultConfig = {default with projectRoot; bsbProjectRoot} in match getConfigFile ~projectRoot with | Some bsConfigFile -> ( try @@ -242,7 +243,7 @@ let readConfig ~getConfigFile ~namespace = | Obj {map = bsconf} -> ( match bsconf |> getOpt "gentypeconfig" with | Some (Obj {map = gtconf}) -> parseConfig ~bsconf ~gtconf - | _ -> default) - | _ -> default - with _ -> default) - | None -> default + | _ -> defaultConfig) + | _ -> defaultConfig + with _ -> defaultConfig) + | None -> defaultConfig From 964460db198006b9bcbc41362903b4836a6ec843 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Fri, 18 Oct 2024 15:08:29 +0200 Subject: [PATCH 05/10] refactor: extract funs to remove duplication --- jscomp/gentype/Paths.ml | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index 9fc30569cf..c055d58ca6 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -33,28 +33,30 @@ let remove_project_root_from_absolute_path ~(config : Config.t) source_path = let n = String.length source_path - i in (String.sub source_path i n [@doesNotRaise]) -let getOutputFileRelative ~config source_path = - if Filename.is_relative source_path then - (source_path |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config +let appendSuffix ~config sourcePath = + (sourcePath |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config + +let getOutputFileRelative ~config sourcePath = + if Filename.is_relative sourcePath then appendSuffix ~config sourcePath else let relative_path = - remove_project_root_from_absolute_path ~config source_path + remove_project_root_from_absolute_path ~config sourcePath in - (relative_path |> handleNamespace) - ^ ModuleExtension.tsInputFileSuffix ~config + appendSuffix ~config relative_path + +let computeAbsoluteOutputFilePath ~(config : Config.t) path = + Filename.concat config.projectRoot (getOutputFileRelative ~config path) let getOutputFile ~(config : Config.t) sourcePath = if Filename.is_relative sourcePath then (* assuming a relative path from the project root *) - Filename.concat config.projectRoot - (getOutputFileRelative ~config sourcePath) + computeAbsoluteOutputFilePath ~config sourcePath else - (* we want to place the output beside the source file *) + (* for absolute paths we want to place the output beside the source file *) let relative_path = remove_project_root_from_absolute_path ~config sourcePath in - Filename.concat config.projectRoot - (getOutputFileRelative ~config relative_path) + computeAbsoluteOutputFilePath ~config relative_path let getModuleName cmt = cmt |> handleNamespace |> Filename.basename |> ModuleName.fromStringUnsafe From c7ff1b6fe406a14a25ddb9d77d8ffb792d170f8a Mon Sep 17 00:00:00 2001 From: Bushuo Date: Fri, 18 Oct 2024 15:46:53 +0200 Subject: [PATCH 06/10] fix: consider file seperators --- jscomp/gentype/Paths.ml | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index c055d58ca6..be75092804 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -28,10 +28,14 @@ let findNameSpace cmt = cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise]) |> keepAfterDash -let remove_project_root_from_absolute_path ~(config : Config.t) source_path = - let i = String.length config.projectRoot + 1 in - let n = String.length source_path - i in - (String.sub source_path i n [@doesNotRaise]) +let removePathPrefix ~prefix path = + let normalizedPrefix = Filename.concat prefix "" in + let prefixLen = String.length normalizedPrefix in + let pathLen = String.length path in + let isPrefix = + prefixLen <= pathLen && String.sub path 0 prefixLen = normalizedPrefix + in + if isPrefix then String.sub path prefixLen (pathLen - prefixLen) else path let appendSuffix ~config sourcePath = (sourcePath |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config @@ -40,7 +44,7 @@ let getOutputFileRelative ~config sourcePath = if Filename.is_relative sourcePath then appendSuffix ~config sourcePath else let relative_path = - remove_project_root_from_absolute_path ~config sourcePath + removePathPrefix ~prefix:config.projectRoot sourcePath in appendSuffix ~config relative_path @@ -54,7 +58,7 @@ let getOutputFile ~(config : Config.t) sourcePath = else (* for absolute paths we want to place the output beside the source file *) let relative_path = - remove_project_root_from_absolute_path ~config sourcePath + removePathPrefix ~prefix:config.projectRoot sourcePath in computeAbsoluteOutputFilePath ~config relative_path From 5d289d0eff483e252d6603541ce6f59e0ddea3a6 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Sat, 19 Oct 2024 07:10:07 +0200 Subject: [PATCH 07/10] fix: please static checker --- jscomp/gentype/Paths.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index be75092804..4ee24113b5 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -33,9 +33,12 @@ let removePathPrefix ~prefix path = let prefixLen = String.length normalizedPrefix in let pathLen = String.length path in let isPrefix = - prefixLen <= pathLen && String.sub path 0 prefixLen = normalizedPrefix + prefixLen <= pathLen + && (String.sub path 0 prefixLen [@doesNotRaise]) = normalizedPrefix in - if isPrefix then String.sub path prefixLen (pathLen - prefixLen) else path + if isPrefix then + String.sub path prefixLen (pathLen - prefixLen) [@doesNotRaise] + else path let appendSuffix ~config sourcePath = (sourcePath |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config From bc8f07fc4cced28128b7867979bae1bdbbebfa42 Mon Sep 17 00:00:00 2001 From: Bushuo Date: Sun, 20 Oct 2024 22:36:19 +0200 Subject: [PATCH 08/10] make find source file return only absolute paths --- jscomp/gentype/FindSourceFile.ml | 13 +++++++++++-- jscomp/gentype/FindSourceFile.mli | 8 ++++++++ 2 files changed, 19 insertions(+), 2 deletions(-) create mode 100644 jscomp/gentype/FindSourceFile.mli diff --git a/jscomp/gentype/FindSourceFile.ml b/jscomp/gentype/FindSourceFile.ml index b935a5e2bb..b646f077cb 100644 --- a/jscomp/gentype/FindSourceFile.ml +++ b/jscomp/gentype/FindSourceFile.ml @@ -14,8 +14,17 @@ let rec implementation items = | false -> Some str_loc.loc_start.pos_fname) | [] -> None +let transform_to_absolute_path (path : string option) = + let transform path = + if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path + else path + in + Option.map transform path + let cmt cmt_annots = match cmt_annots with - | Cmt_format.Interface signature -> interface signature.sig_items - | Implementation structure -> implementation structure.str_items + | Cmt_format.Interface signature -> + transform_to_absolute_path (interface signature.sig_items) + | Implementation structure -> + transform_to_absolute_path (implementation structure.str_items) | _ -> None diff --git a/jscomp/gentype/FindSourceFile.mli b/jscomp/gentype/FindSourceFile.mli new file mode 100644 index 0000000000..6c7bab7a7d --- /dev/null +++ b/jscomp/gentype/FindSourceFile.mli @@ -0,0 +1,8 @@ +val cmt : Cmt_format.binary_annots -> string option +(** + [cmt annots] given [Cmt_format.binary_annots] it returns an absolute source file path + if the file exists, otherwise it returns None. + + @param annots The binary annotations to be processed. + @return An optional absolute path to the source file. +*) From 10a98bb602093dc3bfa03dd6edfe125e899dfaec Mon Sep 17 00:00:00 2001 From: Bushuo Date: Sun, 20 Oct 2024 22:37:11 +0200 Subject: [PATCH 09/10] refactor: cleanup getOutputFile and getOutputFileRelative --- jscomp/gentype/Paths.ml | 26 ++++++-------------------- 1 file changed, 6 insertions(+), 20 deletions(-) diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index 4ee24113b5..a79c721d84 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -43,27 +43,13 @@ let removePathPrefix ~prefix path = let appendSuffix ~config sourcePath = (sourcePath |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config -let getOutputFileRelative ~config sourcePath = - if Filename.is_relative sourcePath then appendSuffix ~config sourcePath - else - let relative_path = - removePathPrefix ~prefix:config.projectRoot sourcePath - in - appendSuffix ~config relative_path - -let computeAbsoluteOutputFilePath ~(config : Config.t) path = - Filename.concat config.projectRoot (getOutputFileRelative ~config path) +let getOutputFileRelative ~(config : Config.t) path = + let relativePath = removePathPrefix ~prefix:config.projectRoot path in + appendSuffix ~config relativePath -let getOutputFile ~(config : Config.t) sourcePath = - if Filename.is_relative sourcePath then - (* assuming a relative path from the project root *) - computeAbsoluteOutputFilePath ~config sourcePath - else - (* for absolute paths we want to place the output beside the source file *) - let relative_path = - removePathPrefix ~prefix:config.projectRoot sourcePath - in - computeAbsoluteOutputFilePath ~config relative_path +let getOutputFile ~(config : Config.t) absoluteSourcePath = + let relativeOutputPath = getOutputFileRelative ~config absoluteSourcePath in + Filename.concat config.projectRoot relativeOutputPath let getModuleName cmt = cmt |> handleNamespace |> Filename.basename |> ModuleName.fromStringUnsafe From c778eb4820ed5ef944e773e8b7ce8980a3e6d2fc Mon Sep 17 00:00:00 2001 From: Bushuo Date: Sun, 20 Oct 2024 21:53:34 +0200 Subject: [PATCH 10/10] chore: update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index a4debfd5cb..37a91b0811 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,7 @@ # 11.1.5 (Unreleased) +- Handle absolute file paths in gentype https://github.com/rescript-lang/rescript-compiler/pull/7111 - Deprecate JSX 3 https://github.com/rescript-lang/rescript-compiler/pull/7042 - Deprecate js_cast.res https://github.com/rescript-lang/rescript-compiler/pull/7074 - Deprecate top-level `"suffix"` option in `rescript.json`. https://github.com/rescript-lang/rescript-compiler/pull/7056