diff --git a/CHANGELOG.md b/CHANGELOG.md index d1b7f2d0b3..0b9f8c3366 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,9 +22,10 @@ - Use FORCE_COLOR environmental variable to force colorized output https://github.com/rescript-lang/rescript-compiler/pull/7033 - 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 -- Fix the issue where dynamic imports are not working for function-defined externals. https://github.com/rescript-lang/rescript-compiler/pull/7060 +- Fix the issue where dynamic imports are not working for function-defined externals. https://github.com/rescript-lang/rescript-compiler/pull/7060 - Allow pattern matching on dicts. `switch someDict { | dict{"one": 1} => Js.log("one is one") }`. https://github.com/rescript-lang/rescript-compiler/pull/7059 - "ReScript Core" standard library is now included in the `rescript` npm package. https://github.com/rescript-lang/rescript-compiler/pull/7108 +- Handle absolute filepaths in gentype. https://github.com/rescript-lang/rescript-compiler/pull/7104 #### :bug: Bug fix diff --git a/compiler/gentype/FindSourceFile.ml b/compiler/gentype/FindSourceFile.ml index b935a5e2bb..b646f077cb 100644 --- a/compiler/gentype/FindSourceFile.ml +++ b/compiler/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/compiler/gentype/FindSourceFile.mli b/compiler/gentype/FindSourceFile.mli new file mode 100644 index 0000000000..6c7bab7a7d --- /dev/null +++ b/compiler/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. +*) diff --git a/compiler/gentype/GenTypeConfig.ml b/compiler/gentype/GenTypeConfig.ml index 3c0744b5d6..c74706f03e 100644 --- a/compiler/gentype/GenTypeConfig.ml +++ b/compiler/gentype/GenTypeConfig.ml @@ -239,6 +239,7 @@ let read_config ~get_config_file ~namespace = sources; } in + let default_config = {default with project_root; bsb_project_root} in match get_config_file ~project_root with | Some bs_config_file -> ( try @@ -247,7 +248,7 @@ let read_config ~get_config_file ~namespace = | Obj {map = bsconf} -> ( match bsconf |> get_opt "gentypeconfig" with | Some (Obj {map = gtconf}) -> parse_config ~bsconf ~gtconf - | _ -> default) - | _ -> default - with _ -> default) - | None -> default + | _ -> default_config) + | _ -> default_config + with _ -> default_config) + | None -> default_config diff --git a/compiler/gentype/GenTypeMain.ml b/compiler/gentype/GenTypeMain.ml index 54f9923542..ed5d41654a 100644 --- a/compiler/gentype/GenTypeMain.ml +++ b/compiler/gentype/GenTypeMain.ml @@ -90,74 +90,79 @@ let read_cmt cmt_file = Log_.item "Try to clean and rebuild.\n\n"; assert false +let read_input_cmt is_interface cmt_file = + let input_cmt = read_cmt cmt_file in + let ignore_interface = ref false in + let check_annotation ~loc:_ attributes = + if + attributes + |> Annotation.get_attribute_payload + Annotation.tag_is_gentype_ignore_interface + <> None + then ignore_interface := true; + attributes + |> Annotation.get_attribute_payload + Annotation.tag_is_one_of_the_gentype_annotations + <> None + in + let has_gentype_annotations = + input_cmt |> cmt_check_annotations ~check_annotation + in + if is_interface then + let cmt_file_impl = + (cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" + in + let input_cmt_impl = read_cmt cmt_file_impl in + let has_gentype_annotations_impl = + input_cmt_impl + |> cmt_check_annotations ~check_annotation:(fun ~loc attributes -> + if attributes |> check_annotation ~loc then ( + if not !ignore_interface then ( + Log_.Color.setup (); + Log_.info ~loc ~name:"Warning genType" (fun ppf () -> + Format.fprintf ppf + "Annotation is ignored as there's a .resi file")); + true) + else false) + in + ( (match !ignore_interface with + | true -> input_cmt_impl + | false -> input_cmt), + match !ignore_interface with + | true -> has_gentype_annotations_impl + | false -> has_gentype_annotations ) + else (input_cmt, has_gentype_annotations) + let process_cmt_file cmt = let config = Paths.read_config ~namespace:(cmt |> Paths.find_name_space) in if !Debug.basic then Log_.item "Cmt %s\n" cmt; let cmt_file = cmt |> Paths.get_cmt_file in if cmt_file <> "" then - let output_file = cmt |> Paths.get_output_file ~config in - let output_file_relative = cmt |> Paths.get_output_file_relative ~config in let file_name = cmt |> Paths.get_module_name in let is_interface = Filename.check_suffix cmt_file ".cmti" in + let input_cmt, has_gentype_annotations = + read_input_cmt is_interface cmt_file + in + let source_file = + match input_cmt.cmt_annots |> FindSourceFile.cmt with + | Some source_file -> source_file + | None -> ( + (file_name |> ModuleName.to_string) + ^ + match is_interface with + | true -> ".resi" + | false -> ".res") + in + let output_file = source_file |> Paths.get_output_file ~config in + let output_file_relative = + source_file |> Paths.get_output_file_relative ~config + in let resolver = ModuleResolver.create_lazy_resolver ~config ~extensions:[".res"; ".shim.ts"] ~exclude_file:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in - let input_cmt, has_gentype_annotations = - let input_cmt = read_cmt cmt_file in - let ignore_interface = ref false in - let check_annotation ~loc:_ attributes = - if - attributes - |> Annotation.get_attribute_payload - Annotation.tag_is_gentype_ignore_interface - <> None - then ignore_interface := true; - attributes - |> Annotation.get_attribute_payload - Annotation.tag_is_one_of_the_gentype_annotations - <> None - in - let has_gentype_annotations = - input_cmt |> cmt_check_annotations ~check_annotation - in - if is_interface then - let cmt_file_impl = - (cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" - in - let input_cmt_impl = read_cmt cmt_file_impl in - let has_gentype_annotations_impl = - input_cmt_impl - |> cmt_check_annotations ~check_annotation:(fun ~loc attributes -> - if attributes |> check_annotation ~loc then ( - if not !ignore_interface then ( - Log_.Color.setup (); - Log_.info ~loc ~name:"Warning genType" (fun ppf () -> - Format.fprintf ppf - "Annotation is ignored as there's a .resi file")); - true) - else false) - in - ( (match !ignore_interface with - | true -> input_cmt_impl - | false -> input_cmt), - match !ignore_interface with - | true -> has_gentype_annotations_impl - | false -> has_gentype_annotations ) - else (input_cmt, has_gentype_annotations) - in if has_gentype_annotations then - let source_file = - match input_cmt.cmt_annots |> FindSourceFile.cmt with - | Some source_file -> source_file - | None -> ( - (file_name |> ModuleName.to_string) - ^ - match is_interface with - | true -> ".resi" - | false -> ".res") - in input_cmt |> translate_c_m_t ~config ~output_file_relative ~resolver |> emit_translation ~config ~file_name ~output_file ~output_file_relative diff --git a/compiler/gentype/Paths.ml b/compiler/gentype/Paths.ml index 5aa23aaada..89aeb8053b 100644 --- a/compiler/gentype/Paths.ml +++ b/compiler/gentype/Paths.ml @@ -29,17 +29,40 @@ let find_name_space cmt = cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise]) |> keep_after_dash -let get_output_file_relative ~config cmt = - (cmt |> handle_namespace) ^ ModuleExtension.ts_input_file_suffix ~config +let remove_path_prefix ~prefix path = + let normalized_prefix = Filename.concat prefix "" in + let prefix_len = String.length normalized_prefix in + let path_len = String.length path in + let is_prefix = + prefix_len <= path_len + && (String.sub path 0 prefix_len [@doesNotRaise]) = normalized_prefix + in + if is_prefix then + String.sub path prefix_len (path_len - prefix_len) [@doesNotRaise] + else path + +let append_suffix ~config source_path = + (source_path |> handle_namespace) + ^ ModuleExtension.ts_input_file_suffix ~config -let get_output_file ~(config : Config.t) cmt = - Filename.concat config.project_root (get_output_file_relative ~config cmt) +let get_output_file_relative ~(config : Config.t) source_path = + let relativePath = + remove_path_prefix ~prefix:config.project_root source_path + in + append_suffix ~config relativePath + +let get_output_file ~(config : Config.t) source_path = + let relative_output_path = get_output_file_relative ~config source_path in + Filename.concat config.project_root relative_output_path let get_module_name cmt = cmt |> handle_namespace |> Filename.basename |> ModuleName.from_string_unsafe let get_cmt_file cmt = - let path_cmt = Filename.concat (Sys.getcwd ()) cmt in + let path_cmt = + if Filename.is_relative cmt then Filename.concat (Sys.getcwd ()) cmt + else cmt + in let cmt_file = if Filename.check_suffix path_cmt ".cmt" then let path_cmt_lower_case =